searching for data in a lot of sheets and copying entire row if data is found to a separate work she-CodePudding

Hi I'm relatively new to VBA and programing and im having an "overflow" issue with my code

I'm trying to to go through the first 31 work sheets search for the term "Power On" in column C and when it find a match copy the entire row and paste it into Sheet33 it was working at one point for just a single sheet but now i cant get it to work after modifying it for the first 31 sheets

any help would be greatly appreciated!

   Sub test()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer
   Dim ws1 As Worksheet
   Dim I As Integer
   
   LCopyToRow = 1

         
    For I = 1 To 31
       Set ws1 = ActiveSheet
   
   LSearchRow = 1


   While Len(Range("A" & CStr(LSearchRow)).Value) > 0

      'If value in column C = "Power On", copy entire row to Sheet33
      If Range("C" & CStr(LSearchRow)).Value = "Power On" Then

         'Select row in ws1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy

         'Paste row into Sheet33 in next row
         Sheets("Sheet33").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         LCopyToRow = LCopyToRow   1

         'Go back to ws1
         Sheets(ws1).Select

      End If

      LSearchRow = LSearchRow   1
      
   Wend

   Exit Sub
    
    Next I

End Sub

CodePudding user response：

'Overflow' error happens when your declared data variable of a certain datatype can no longer hold the SIZE of the value you are putting in it. Based on your code, LSearchRow and LCopyToRow are declared as INTEGER which can hold up to 32767 (rows). to fix this declare it as LONG instead of INTEGER:

Dim LSearchRow As Long
Dim LCopyToRow As Long

Now to make your worksheet loop work, insert these codes:

Dim wsCount as Long
wsCount = Thisworkbook.Worksheets.Count

Then modify your loop to this. This will automatically scan through all the sheets in that workbook

For I = 1 To wsCount
   'leave as is 
Next I

Your current LOOP doesn't do anything, it just counts 1 to 31, and is not related to 'ws1' that's why it only works on 1 sheet.

CodePudding user response：

ok just try the following code many fixes are made and speedUps

Sub test()
       ' in a x64 environement better forget Integers and go for Longs
       Dim LSearchRow As Long
       Dim LCopyToRow As Long
       Dim ws1 As Worksheet
       Dim I As Long
       Dim vldRng As Range
       Dim maxRw As Long
       Dim maxClmn As Long
       Dim rngDest As Range
       
       '2 Lines to speed code Immensly. Don't use them while debugging
       Application.ScreenUpdating = False
       Application.Calculation = xlCalculationManual
    
       LCopyToRow = 1
       Set rngDest = ThisWorkbook.Sheets("Sheet33").Cells(1, 1)
    
        For I = 1 To 31
           Set ws1 = ThisWorkbook.Sheets(I)
           Set vldRng = ws1.UsedRange       ' Get range used instead of searching entire Sheet
           
           maxRw = vldRng.Rows.Count
           maxClmn = vldRng.Columns.Count
        
           For LSearchRow = 1 To maxRw
        
              'If value in column C = "Power On", copy entire row to Sheet33
              If vldRng.Cells(LSearchRow, 3).Value = "Power On" Then
        
                 'Select row in ws1 to copy
                 vldRng.Cells(LSearchRow, 1).Resize(1, maxClmn).Copy
        
                 'Paste row into Sheet33 in next row
                 rngDest.Offset(LCopyToRow - 1, 0).PasteSpecial xlPasteValues
                 LCopyToRow = LCopyToRow   1
        
              End If
        
           Next LSearchRow
    
        Next I
    
       Application.ScreenUpdating = True
       Application.Calculation = xlCalculationAutomatic
    
    End Sub

CodePudding user response：

' The reason you are getting the same sheet is you are setting WS1 to ActiveSheet
' 31 times in a row -- not getting the first 31 sheets.
' ActiveSheet is whatever sheet you last happened to have in focus.  Unless you
' know you want that (almost never), you should not use it.

' You want to avoids things like copy / paste / select.  These are slow.

' You also want to avoid processing things row by row.

' Here is an example that should do what you want.

Sub ThirtyOneFlavors()
Const PowerColNum = 3  ' if you are sure it will always be column 3
Dim WS1 As Worksheet, WS33 As Worksheet
Dim PowerColumn As Range, PowerCell As Range, FirstCell As Range, R As Long
  
    Set WS33 = ThisWorkbook.Sheets("Sheet33")  ' Maybe this could use a clever name
    WS33.Cells.Delete  ' only if you want this
  
    ' using ThisWorkbook avoids accidentally getting some other open workbook
    For Each WS1 In ThisWorkbook.Sheets
        ' here, put the names of any sheets you don't want to process
        If WS1.Name <> WS33.Name Then
            Set PowerColumn = WS1.UsedRange.Columns(PowerColNum)
            ' I am assuming Power On is the whole column
            Set PowerCell = PowerColumn.Find("Power On", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            If Not PowerCell Is Nothing Then   ' if you found something
                ' we need to keep track of the first one found,
                ' otherwise Excel will keep finding the same one repeatedly
                Set FirstCell = PowerCell
            End If
            
            While Not PowerCell Is Nothing   ' if you keep finding cells
                R = R   1  ' next row
                '.Value will hold all of the values in a range (no need to paste)
                WS33.Cells(R, 1).EntireRow.Value = PowerCell.EntireRow.Value
                ' get the next one
                Set PowerCell = PowerColumn.Find("Power On", after:=PowerCell, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
                If PowerCell.Address = FirstCell.Address Then
                    ' if we found the first one again, kill the loop
                    Set PowerCell = Nothing
                End If
            Wend
        End If
    Next WS1

End Sub