Combining two VBA

pete4monc

Board Regular
Joined
Jan 12, 2014
Messages
75
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
75
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

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
74,540
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
75
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
74,540
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
75
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
74,540
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,514
Messages
5,854,173
Members
431,623
Latest member
ncorkren

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