Combining two VBA

pete4monc

Board Regular
Joined
Jan 12, 2014
Messages
78
Office Version
  1. 365
Platform
  1. Windows
Hi all

I am new to vba and need some help. I have copied, modified and tried multiple vba to do the below but can't seem to get one to do all that I need.
I have one workbook with 10 worksheets in. I need my vba to look in all sheets in column L.
If there is a value greater then 3, copy the corresponding cell in column B to sheet 1 but inserting the sheet name in Column A first.
Then check all sheets.

please see my code below, any help will be greatly appreciated.

Sub filldata()

Sheets("Sheet1").Select
Range("A1:A20").Select
Selection.ClearContents
Range("A1").Select

LastRow = Sheet2.Range("L20").End(xlUp).Row
i = 2
j = 1

For i = 2 To LastRow

If Sheet2.Range("H" & i).Value <> 0 Then 'the condition to check

Sheet1.Range("B" & j).Value = Sheet2.Range("A" & i).Value

j = j + 1

End If


Next


End Sub
 

pete4monc

Board Regular
Joined
Jan 12, 2014
Messages
78
Office Version
  1. 365
Platform
  1. Windows
Hi Fluff

Tested the 2nd code on the short workbook and it works perfect.
Could it be the sheet names are too long in my workbook or the amount of worksheets?
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
76,313
Office Version
  1. 365
Platform
  1. Windows
It's more likely to be the data, check the the numbers in col L are real numbers & not text.
 

pete4monc

Board Regular
Joined
Jan 12, 2014
Messages
78
Office Version
  1. 365
Platform
  1. Windows
I think I have found the issue. So sorry to have messed you around.

In Column L there is a formula =IF(I6="",NETWORKDAYS(H6, TODAY(),'Holiday List'!$B$2:$B$23),"")
This is to report the number of days the department has had the file (less weekends and holidays) if there is no completion date in column I.
Is this formula something that can be written into vba or is this a lost cause?
 

Attachments

  • Capture3.PNG
    Capture3.PNG
    29.8 KB · Views: 5

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
76,313
Office Version
  1. 365
Platform
  1. Windows
Ok, it's the fact that "" is a text & therefore greater than 3. Try
VBA Code:
Sub pete4monc()
   Dim ws As Worksheet
   Dim Ary As Variant, Rws As Variant
   
   For Each ws In Worksheets
      Select Case ws.Name
         Case "Sheet2", "Sheet3", "Sheet7"      'sheets that should be ignored
         Case Else
            With ws.Range("B2:B" & ws.Range("L" & Rows.Count).End(xlUp).Row)
               Rws = Filter(ws.Evaluate(Replace("transpose(if((@>3)*(@<>""""),row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
               If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
            End With
            If UBound(Rws) >= 0 Then
               With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
                  .Resize(UBound(Ary)).Value = ws.Name
                  .Offset(, 1).Resize(UBound(Ary)).Value = Ary
               End With
            End If
      End Select
   Next ws
End Sub
 
Solution

pete4monc

Board Regular
Joined
Jan 12, 2014
Messages
78
Office Version
  1. 365
Platform
  1. Windows
Ok, it's the fact that "" is a text & therefore greater than 3. Try
VBA Code:
Sub pete4monc()
   Dim ws As Worksheet
   Dim Ary As Variant, Rws As Variant
  
   For Each ws In Worksheets
      Select Case ws.Name
         Case "Sheet2", "Sheet3", "Sheet7"      'sheets that should be ignored
         Case Else
            With ws.Range("B2:B" & ws.Range("L" & Rows.Count).End(xlUp).Row)
               Rws = Filter(ws.Evaluate(Replace("transpose(if((@>3)*(@<>""""),row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
               If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
            End With
            If UBound(Rws) >= 0 Then
               With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
                  .Resize(UBound(Ary)).Value = ws.Name
                  .Offset(, 1).Resize(UBound(Ary)).Value = Ary
               End With
            End If
      End Select
   Next ws
End Sub
Thanks Fluff.
That worked a treat. I really appreciate the help.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
76,313
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Forum statistics

Threads
1,172,007
Messages
5,878,707
Members
433,365
Latest member
lw10724

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top