Solved

vba to perform filters within a looped sequence

Posted on 2016-08-08
11
53 Views
Last Modified: 2016-08-12
Having had EE help to enable my example to loop through a list of actionable sheets, I have the challenge of now being asked to insert 3 types of filter for every sheet opened in the loop.
For me the difficulty is whilst I can code the individual filters - I cannot grasp the VBA semantics of how they are incorporated into the loop
Any help would be appreciated
Test-1.xlsm
0
Comment
Question by:DAVID131
  • 6
  • 5
11 Comments
 
LVL 45

Expert Comment

by:Martin Liss
ID: 41747480
Are you talking about something like this? (See l.ine 27)
Sub CopyDataToSummary()
Dim ws As Worksheet, dws As Worksheet, admWs As Worksheet
Dim lr As Long, alr As Long, i As Long, dlr As Long
Dim x
Application.ScreenUpdating = False
Set dws = Sheets("percent upload")
Set admWs = Sheets("Admin")
'dws.Cells.Clear
dws.Range("A1:F1").Value = Array("", "Branch", "Line", "", "", "Override")
alr = admWs.Cells(Rows.Count, 2).End(xlUp).Row
If alr < 6 Then
   MsgBox "There are no sheets listed on Admin Sheet.", vbExclamation, "Sheet List Not Found!"
   Exit Sub
End If
x = admWs.Range("B5:B" & alr).Value
For i = 1 To UBound(x, 1)
   On Error Resume Next
   Set ws = Sheets(x(i, 1))
   If Not ws Is Nothing Then
      lr = ws.Cells(Rows.Count, 22).End(xlUp).Row
      If lr > 5 Then
         ws.Range("V6:Z" & lr).Copy
         dws.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
         Application.CutCopyMode = 0
      End If
      '
      ' Do something else here???
      '
   End If
Next i
'dws.Range("C5").CurrentRegion.Borders.Color = vbBlack
Application.ScreenUpdating = True
MsgBox "Data has been copied to Summary Sheet successfully.", vbInformation, "Done!"
End Sub

Open in new window

0
 

Author Comment

by:DAVID131
ID: 41748343
Good Morning Martin
Thanks for the response
I have tried to amend the code to carry out actions 2 and 3 in the admin sheet but have been unsuccessful.
Could you advise on what I am doing wrong - and I will try again
Test-1.01.xlsm
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 41749011
What value are you trying to retrieve in line 15, and what are you attempting to do in line 16? (I indented some of your code to make it easier to read.)

Sub CopyDataToSummary()
Dim ws As Worksheet, dws As Worksheet, admWs As Worksheet
Dim lr As Long, alr As Long, i As Long, dlr As Long
Dim x
Application.ScreenUpdating = False
Set dws = Sheets("percent upload")
Set admWs = Sheets("Admin")
'dws.Cells.Clear
dws.Range("A1:F1").Value = Array("", "Branch", "Line", "", "", "Override")
alr = admWs.Cells(Rows.Count, 2).End(xlUp).Row
If alr < 6 Then
   MsgBox "There are no sheets listed on Admin Sheet.", vbExclamation, "Sheet List Not Found!"
   Exit Sub
End If
x = admWs.Range("B5:B" & alr).Value
For i = 1 To UBound(x, 1)
   On Error Resume Next
   Set ws = Sheets(x(i, 1))
   If Not ws Is Nothing Then
      lr = ws.Cells(Rows.Count, 22).End(xlUp).Row
      If lr > 5 Then
         'ws.Range("V6:Z" & lr).Copy
         'dws.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
         'Application.CutCopyMode = 0
         If ActiveSheet.AutoFilterMode = True Then
            Selection.AutoFilter
         End If
         XROW = Range("v999999").End(xlUp).Row
         ws.Range("v6").Select
         Selection.AutoFilter
         ActiveSheet.Range("$V$6:$Z" & XROW).AutoFilter Field:=1, Criteria1:=">=1"
         Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
         For Each rngrow In filteredrange.Rows
            lastrow = rngrow.Row
            Firstrow = rngrow.Row
        
         Next
         ws.Range("V" & Firstrow & "z" & lastrow).Select
         Selection.Copy
         Sheets("percent upload").Select
         If Range("B2").Value = "" Then
            Range("B2").Select
         Else
            Range("B1").End(xlDown).Select
         End If
         Selection.Paste.Special Paste:=xlPasteValues
         Application.CutCopyMode = False
        
         
      End If
      
     
   End If
Next i
'dws.Range("C5").CurrentRegion.Borders.Color = vbBlack
Application.ScreenUpdating = True
MsgBox "Data has been copied to Summary Sheet successfully.", vbInformation, "Done!"
End Sub

Open in new window

0
 

Author Comment

by:DAVID131
ID: 41749874
Good Morning Martin
Lines 15 and 16 were part of the original code that worked very well, therefore I left them in as they appeared to be part of the instruction to loop through the admin list of sheets with content to be copied.
Whereas the original code copied semi-fixed cells what I am trying to do is insert code that filters those semi-fixed cells and copies the resulting values into the percent upload within the loop that reads the list of sheets in the admin sheet.
I am trying to learn from this so any explanations would be appreciated
0
 

Author Comment

by:DAVID131
ID: 41750146
Martin
In the attached I have written the code for the 3 filters that I need to be enacted within the original loop code, however I have two problems
1. How do I incorporate the filter codes (which work) within the admin looping code (which works)
2. The third filter requires the paste value to be repeated 3 times but I am getting run time error 1004
EE-Test-2.xlsm
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 45

Expert Comment

by:Martin Liss
ID: 41750722
OK, if you change the test_filter sub so that it looks like this, where I've replaced "sheet 05" with a variable...

Sub test_filter(ws As Worksheet)
'
' test_filter Macro
'
' perform first filter
'
    Sheets(ws).Select
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("V999999").End(xlUp).Row
    
    Range("V5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$V$5:$z$" & xrow).AutoFilter field:=1, Criteria1:="<700", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("V" & firstrow & ":Z" & lastrow).Select
    Selection.Copy
    Sheets("percent upload 2").Select
    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H1").Select
    
   'perform second filter
   
    End If
    
  Sheets(ws).Select
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("AA999999").End(xlUp).Row
    
    Range("AA5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$AA$5:$AE$" & xrow).AutoFilter field:=2, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("AA" & firstrow & ":AE" & lastrow).Select
    Selection.Copy
    Sheets("percent upload 2").Select
    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H1").Select
    End If
    
    'perform 3rd filter multiple times
    
    
    Sheets(ws).Select
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("N999999").End(xlUp).Row
    
    Range("N5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$N$5:$O$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    
    
    If firstrow > 0 Then
    Range("N" & firstrow & ":O" & lastrow).Select
    Selection.Copy
    Sheets("value upload 2").Select
    If Range("A2").Value = "" Then
    Range("A2").Select
    Else
   
    Range("A1").End(xlDown).Offset(1, 0).Select
    End If
    For J = 1 To 3 'THIS PRODUCES ERROR WARNING - Error warning 1004 PASTE SPECIAL METHOD OF RANGE CLASS FAILED
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   Next J
    Range("H1").Select
    End If
    

    
End Sub

Open in new window


...you can call it from the loop as I've done at line 21 (although I don't fully understand what you need so I don't know if that's the right place).
Sub CopyDataToSummary()
Dim ws As Worksheet, dws As Worksheet, admWs As Worksheet
Dim lr As Long, alr As Long, i As Long, dlr As Long
Dim x
Application.ScreenUpdating = False
Set dws = Sheets("percent upload")
Set admWs = Sheets("Admin")
'dws.Cells.Clear
dws.Range("A1:F1").Value = Array("", "Branch", "Line", "", "", "Override")
alr = admWs.Cells(Rows.Count, 2).End(xlUp).Row
If alr < 6 Then
   MsgBox "There are no sheets listed on Admin Sheet.", vbExclamation, "Sheet List Not Found!"
   Exit Sub
End If
x = admWs.Range("B5:B" & alr).Value
For i = 1 To UBound(x, 1)
   On Error Resume Next
   Set ws = Sheets(x(i, 1))
   If Not ws Is Nothing Then
   
      test_filter Sheets(ws)

      lr = ws.Cells(Rows.Count, 22).End(xlUp).Row
      If lr > 5 Then
         ws.Range("V6:Z" & lr).Copy
         dws.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
         Application.CutCopyMode = 0
      End If
   End If
Next i
'dws.Range("C5").CurrentRegion.Borders.Color = vbBlack
Application.ScreenUpdating = True
MsgBox "Data has been copied to Summary Sheet successfully.", vbInformation, "Done!"
End Sub

Open in new window

0
 

Author Comment

by:DAVID131
ID: 41752130
Good Afternoon Martin
I feel we are so close to cracking this.
I have attached two workbooks
EE4.00 with the stand alone macros all working ok
EE4.01 with the primary macro looping through a list of sheets and calling up the new (routine - not sure of my semantics ?) which whilst producing no errors does not produce any values

Along the journey I have resolved the 3rd filter performing multiple copies by using a  Do While loop

I have never used a sub with the parentheses populated and may have done something stupid
Could you advise on what I have done wrong
Thanks
EE-4.00----3-Filters-1-sheet-ok-.xlsm
EE-4.01----Combined-not-ok.xlsm
0
 
LVL 45

Accepted Solution

by:
Martin Liss earned 500 total points
ID: 41752343
OK, I believe this fixes the problems. The changes I made are all annotated between "New Start" and "New End" comments.
Sub CopyDataToSummary()
Dim ws As Worksheet, dws As Worksheet, admWs As Worksheet
Dim lr As Long, alr As Long, i As Long, dlr As Long
Dim x
Application.ScreenUpdating = False
Set dws = Sheets("percent upload")
Set admWs = Sheets("Admin")
'dws.Cells.Clear
dws.Range("A1:F1").Value = Array("", "Branch", "Line", "", "", "Override")
alr = admWs.Cells(Rows.Count, 2).End(xlUp).Row
If alr < 6 Then
   MsgBox "There are no sheets listed on Admin Sheet.", vbExclamation, "Sheet List Not Found!"
   Exit Sub
End If
'******* New Start *******
' This code creates an array of sheet names. I changed it because using B5 as
' the starting point resulted in "Sheets" (the heading) being included in the
' array. That caused the Set ws = Sheets(x(i, 1)) line to give a "Subscript
' out of range" error because "Sheets" isn't a valid worklsheet name. That was
' reason the On Error Resume Next statement was there and while it allowed the
' code to continue to the valid sheet names, it hid an error later on (caused
' by me) that resulted in no output. The moral of the story is to never use
' On Error unless there's absolutly no way to avoid it.
'x = admWs.Range("B5:B" & alr).Value
'For i = 1 To UBound(x, 1)
'   On Error Resume Next
x = admWs.Range("B6:B" & alr).Value
For i = 1 To UBound(x, 1)
   Set ws = Sheets(x(i, 1))
'******* New End *********
   
   If Not ws Is Nothing Then
   
   '******* New Start *******
   ' This was my error. ws is a worksheet OBJECT but Three_filters Sheets(ws)
   ' treated it as a string and so when Three_Filters was called a "Type
   ' mismatch" error occurred causing the sub to be bypassed, but all this
   ' was hidden by the On Error code.
   'Three_filters Sheets(ws)
   Three_filters ws
   '******* New End *********
   
   
      'lr = ws.Cells(Rows.Count, 22).End(xlUp).Row
      'If lr > 5 Then
         'ws.Range("V6:Z" & lr).Copy
         'dws.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
         'Application.CutCopyMode = 0
      'End If
   End If
Next i
'dws.Range("C5").CurrentRegion.Borders.Color = vbBlack
Application.ScreenUpdating = True
MsgBox "Data has been copied to Summary Sheet successfully.", vbInformation, "Done!"
End Sub

Open in new window

Sub Three_filters(ws As Worksheet)
'
' three_filters Macro
'
' perform first filter
'
    '******* New Start *******
    ' Again my mistake of treating ws as a String
    ' rather than as a worksheet object
'    Sheets("ws").Select
    ws.Select
    '******* New End *********

    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("V999999").End(xlUp).Row
    
    Range("V5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$V$5:$z$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("V" & firstrow & ":Z" & lastrow).Select
    Selection.Copy
    Sheets("percent upload 2").Select
    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H1").Select
   
    End If
    
    'perform second filter
    
    '******* New Start *******
'    Sheets("ws").Select
    ws.Select
    '******* New End *********
    
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("AA999999").End(xlUp).Row
    
    Range("AA5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$AA$5:$AE$" & xrow).AutoFilter field:=2, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("AA" & firstrow & ":AE" & lastrow).Select
    Selection.Copy
    Sheets("percent upload 2").Select
    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H1").Select
    End If
    
    'perform 3rd filter multiple times
    
    Dim x
    
    '******* New Start *******
'    Sheets("ws").Select
    ws.Select
    '******* New End *********
    
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("N999999").End(xlUp).Row
    
    Range("N5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$N$5:$O$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    
    
    If firstrow > 0 Then
    Range("N" & firstrow & ":O" & lastrow).Select
    
    Let x = 0
    Do While x < 7
    
    Selection.Copy
    Sheets("value upload 2").Select
    If Range("A2").Value = "" Then
    Range("A2").Select
    Else
   
    Range("A1").End(xlDown).Offset(1, 0).Select
    End If
    
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    x = x + 1
    Loop
    
    Range("H1").Select
    End If
    

    
End Sub

Open in new window

BTW, here are a couple articles  that I I've written that I think will help you with programming.
Using the VB6 Debugger (Ignore the fact that it says VB6. Most of it also applies to VBA).
A Guide to Writing Understandable and Maintainable VBA Code
0
 

Author Comment

by:DAVID131
ID: 41752435
Martin
the code worked a treat with the only issue being that where the filter produced no results the macro brought through the header - how do I best trap that out?
109      45
109      45
Branch      Line
Branch      Line
Branch      Line
Branch      Line
Branch      Line
Branch      Line
Branch      Line
117      30
151      25
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 41752992
Make the change at line 118 as shown. Have you noticed the repeating 117, 151, 172 sets in the "value upload 2" sheet? Is that desired?

Sub Three_filters(ws As Worksheet)
'
' three_filters Macro
'
' perform first filter
'
    ws.Select

    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("V999999").End(xlUp).Row
    
    Range("V5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$V$5:$z$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("V" & firstrow & ":Z" & lastrow).Select
    Selection.Copy
    Sheets("percent upload 2").Select
    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H1").Select
   
    End If
    
    'perform second filter
    
    ws.Select
    
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("AA999999").End(xlUp).Row
    
    Range("AA5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$AA$5:$AE$" & xrow).AutoFilter field:=2, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("AA" & firstrow & ":AE" & lastrow).Select
    Selection.Copy
    Sheets("percent upload 2").Select
    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H1").Select
    End If
    
    'perform 3rd filter multiple times
    
    Dim x
    
    ws.Select
    
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("N999999").End(xlUp).Row
    
    Range("N5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$N$5:$O$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    
    '******* New Start *******
'    If firstrow > 0 Then
    If firstrow > 0 And ws.Cells(firstrow, "N") <> "" Then
    '******* New End *********

    Range("N" & firstrow & ":O" & lastrow).Select
    
    Let x = 0
    Do While x < 7
    
    Selection.Copy
    Sheets("value upload 2").Select
    If Range("A2").Value = "" Then
    Range("A2").Select
    Else
   
    Range("A1").End(xlDown).Offset(1, 0).Select
    End If
    
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    x = x + 1
    Loop
    
    Range("H1").Select
    End If
    

    
End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 41753812
I'm glad I was able to help.

In my profile you'll find links to some additional articles I've written that may interest you.

Marty - Microsoft MVP 2009 to 2016
              Experts Exchange MVE 2015
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2015
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now