Snasui Excel Forum

Code: Select all

Sub CommandButton2_Click()

   Dim rng As Range
   Dim myString As String
   Dim i As Long
   Dim N As Long
   Dim intColumn As Integer
  Application.ScreenUpdating = False
                For ListSheet = 1 To Excel.Sheets.Count
                       If Sheets(ListSheet).Range("A1").Value = "ÅíҴѺ" Then
                               N = Sheets(ListSheet).[B:B].Cells.Find("*", , , , xlByRows, xlPrevious).Row
                               Do Until IsEmpty(Cells(1, intColumn).Value) = True
                                   intColumn = intColumn + 1
                               Loop
                        End If
                      
            Next ListSheet
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       On Error Resume Next
        For i = 2 To N
                 Set rng = Sheets("All Re 2015-17").Cells(i, 2)
                 myString = WorksheetFunction.VLookup(rng, Sheets("Data Check").Range(Cells(2, 2), Cells(2 + N, 6)).Value, 5, False)
    
              If myString = "" Then
                 Sheets("All Re 2015-17").Cells(i, intColumn) = ""
                 Err.Clear
               Else
                 Sheets("All Re 2015-17").Cells(i, intColumn) = myString
              End If
       Next i
   
   Worksheets("Summary Reschedule 21-04-17").Activate
   Application.ScreenUpdating = True

End Sub

Code: Select all

Sub CommandButton2_Click()
    
    Dim rng As Range
    Dim myString As String
    Dim i As Long
    Dim N As Long
    Dim intColumn As Integer
    Application.ScreenUpdating = False
    intColumn = 1
    For ListSheet = 1 To Excel.Sheets.Count
        If Sheets(ListSheet).Range("A1").Value = "ลำดับ" Then
            N = Sheets(ListSheet).[B:B].Cells.Find("*", , , , xlByRows, xlPrevious).Row
            Do Until IsEmpty(Sheets(ListSheet).Cells(1, intColumn).Value) = True
                intColumn = intColumn + 1
            Loop
        End If
    Next ListSheet
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    For i = 2 To N
        Set rng = Sheets("All Re 2015-17").Cells(i, 2)
        myString = WorksheetFunction.VLookup(rng, Sheets("Data Check") _
            .Range(Cells(2, 2).Address, Cells(2 + N, 6).Address), 5, False)
        
        If myString = "" Then
            Sheets("All Re 2015-17").Cells(i, intColumn) = ""
            Err.Clear
        Else
            Sheets("All Re 2015-17").Cells(i, intColumn) = myString
        End If
    Next i
    
    Worksheets("Summary Reschedule 21-04-17").Activate
    Application.ScreenUpdating = True
    
End Sub