Copy entire row if CountA <>0 to another sheet

Harshil Mehta

New Member
Joined
May 14, 2020
Messages
19
Office Version
2013
Platform
Windows
How about
VBA Code:
Sub HarshilMehta()
   Dim Ary As Variant, Nary As Variant, Nary2 As Variant
   Dim r As Long, c As Long, nr As Long, cc As Long, nr2 As Long
   Dim Flg As Boolean
  
   With Sheets(3)
      Ary = .Range("A6:AM" & .Range("D" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   ReDim Nary2(1 To UBound(Ary), 1 To UBound(Ary, 2))
   For r = 1 To UBound(Ary)
      Flg = True
      For c = 10 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            Flg = False
            nr = nr + 1
            For cc = 1 To UBound(Ary, 2)
               Nary(nr, cc) = Ary(r, cc)
            Next cc
            Exit For
         End If
      Next c
      If Flg Then
         nr2 = nr2 + 1
         For cc = 1 To UBound(Ary, 2)
            Nary2(nr2, cc) = Ary(r, cc)
         Next cc
      End If
   Next r
   Sheets(1).Range("A1").Resize(nr, UBound(Ary, 2)).Value = Nary
   Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr2, UBound(Ary, 2)).Value = Nary2
End Sub
All the rows which satisfy the condition <> "" should be pasted on top and all the rows which satisfy the condition ="" should pasted in the end. See below for explanation. Everything ran perfectly expect this issue. Could you please help me fix this.

******Sheet1*****
1. rows that satisfy the condition <>""
2. rows that satisfy the condition <>""
3. rows that satisfy the condition =""
 

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,756
Office Version
365
Platform
Windows
That's what the code does.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,756
Office Version
365
Platform
Windows
If I start with this
+Fluff New.xlsm
ABCDEFGHIJKLMNOP
1
2
3
4
5PostcodeIn Use?LatitudeLongitudeEastingNorthingGridRefCountyDistrictWardDistrictCodeWardCodeCountryCountyCodeConstituencyIntroduced
6AL4 0SPYes51.75121-0.28483518495207227TL184072HertfordshireSt AlbansColney HeathE07000240E05009028EnglandE10000015St Albans########
7AL4 8EGYes51.79911-0.31607516216212503TL162125HertfordshireSt Albans
8BS25 1QHYes51.32351-2.8008344295158571ST442585SomersetSedgemoorCheddar and ShiphamE07000188E05008905EnglandE10000027Wells########
9CA10 1REYes54.68003-2.596361669531826NY616318CumbriaEden
10CH1 6LNYes53.23844-2.9201338689371662SJ386716CheshireCheshire West and ChesterSaughall and MollingtonE06000050E05008692EnglandE11000004City of Chester########
11CT16 1PFYes51.125881.313926631983141511TR319415KentDover
12DE15 0QBYes52.79074-1.56753429261321551SK292215DerbyshireSouth DerbyshireNewhall and StantonE07000039E05008817EnglandE10000007South Derbyshire########
13DE7 5QBYes52.971-1.30972446454341738SK464417DerbyshireErewashLittle HallamE07000036E05010614EnglandE10000007Erewash########
14DL8 3AFYes54.29027-1.99533400402488293SE004882North YorkshireRichmondshire
15EX33 1LRYes51.10743-4.16299248674136462SS486364DevonNorth DevonBraunton WestE07000043E05003537EnglandE10000008North Devon########
16EX4 2LEYes50.73842-3.5934728765594412SX876944DevonTeignbridgeTeignbridge NorthE07000045E05003610EnglandE10000008Central Devon########
17HX3 5NSYes53.73978-1.88809407479427050SE074270West YorkshireCalderdaleOvendenE08000033E05001379EnglandE11000019Halifax########
18L9 3BUYes53.45909-2.96334336134396247SJ361962MerseysideLiverpoolWarbreckE08000012E05000911EnglandE11000013Liverpool, Walton########
19LN2 1EWYes53.23045-0.53729497737371377SK977713LincolnshireLincolnAbbeyE07000138E05010784EnglandE10000019Lincoln########
20LS7 4QYYes53.8323-1.53311430826437438SE308374West YorkshireLeedsChapel AllertonE08000035E05001419EnglandE11000019Leeds North East########
21ME12 4QFYes51.400120.920474603244170835TR032708KentSwaleSheppey EastE07000113E05009562EnglandE10000016Sittingbourne and Sheppey########
22MK16 9HJYes52.09267-0.652492447244671SP924446BuckinghamshireMilton KeynesOlneyE06000042E05009418EnglandE10000002Milton Keynes North########
Sheet2


I end up with
+Fluff New.xlsm
ABCDEFGHIJKLMNOP
1AL4 0SPYes51.75121-0.28483518495207227TL184072HertfordshireSt AlbansColney HeathE07000240E05009028EnglandE10000015St Albans########
2BS25 1QHYes51.32351-2.8008344295158571ST442585SomersetSedgemoorCheddar and ShiphamE07000188E05008905EnglandE10000027Wells########
3CH1 6LNYes53.23844-2.9201338689371662SJ386716CheshireCheshire West and ChesterSaughall and MollingtonE06000050E05008692EnglandE11000004City of Chester########
4DE15 0QBYes52.79074-1.56753429261321551SK292215DerbyshireSouth DerbyshireNewhall and StantonE07000039E05008817EnglandE10000007South Derbyshire########
5DE7 5QBYes52.971-1.30972446454341738SK464417DerbyshireErewashLittle HallamE07000036E05010614EnglandE10000007Erewash########
6EX33 1LRYes51.10743-4.16299248674136462SS486364DevonNorth DevonBraunton WestE07000043E05003537EnglandE10000008North Devon########
7EX4 2LEYes50.73842-3.5934728765594412SX876944DevonTeignbridgeTeignbridge NorthE07000045E05003610EnglandE10000008Central Devon########
8HX3 5NSYes53.73978-1.88809407479427050SE074270West YorkshireCalderdaleOvendenE08000033E05001379EnglandE11000019Halifax########
9L9 3BUYes53.45909-2.96334336134396247SJ361962MerseysideLiverpoolWarbreckE08000012E05000911EnglandE11000013Liverpool, Walton########
10LN2 1EWYes53.23045-0.53729497737371377SK977713LincolnshireLincolnAbbeyE07000138E05010784EnglandE10000019Lincoln########
11LS7 4QYYes53.8323-1.53311430826437438SE308374West YorkshireLeedsChapel AllertonE08000035E05001419EnglandE11000019Leeds North East########
12ME12 4QFYes51.400120.920474603244170835TR032708KentSwaleSheppey EastE07000113E05009562EnglandE10000016Sittingbourne and Sheppey########
13MK16 9HJYes52.09267-0.652492447244671SP924446BuckinghamshireMilton KeynesOlneyE06000042E05009418EnglandE10000002Milton Keynes North########
14AL4 8EGYes51.79911-0.31607516216212503TL162125HertfordshireSt Albans
15CA10 1REYes54.68003-2.596361669531826NY616318CumbriaEden
16CT16 1PFYes51.125881.313926631983141511TR319415KentDover
17DL8 3AFYes54.29027-1.99533400402488293SE004882North YorkshireRichmondshire
Sheet1
 

Harshil Mehta

New Member
Joined
May 14, 2020
Messages
19
Office Version
2013
Platform
Windows
If I start with this
+Fluff New.xlsm
ABCDEFGHIJKLMNOP
1
2
3
4
5PostcodeIn Use?LatitudeLongitudeEastingNorthingGridRefCountyDistrictWardDistrictCodeWardCodeCountryCountyCodeConstituencyIntroduced
6AL4 0SPYes51.75121-0.28483518495207227TL184072HertfordshireSt AlbansColney HeathE07000240E05009028EnglandE10000015St Albans########
7AL4 8EGYes51.79911-0.31607516216212503TL162125HertfordshireSt Albans
8BS25 1QHYes51.32351-2.8008344295158571ST442585SomersetSedgemoorCheddar and ShiphamE07000188E05008905EnglandE10000027Wells########
9CA10 1REYes54.68003-2.596361669531826NY616318CumbriaEden
10CH1 6LNYes53.23844-2.9201338689371662SJ386716CheshireCheshire West and ChesterSaughall and MollingtonE06000050E05008692EnglandE11000004City of Chester########
11CT16 1PFYes51.125881.313926631983141511TR319415KentDover
12DE15 0QBYes52.79074-1.56753429261321551SK292215DerbyshireSouth DerbyshireNewhall and StantonE07000039E05008817EnglandE10000007South Derbyshire########
13DE7 5QBYes52.971-1.30972446454341738SK464417DerbyshireErewashLittle HallamE07000036E05010614EnglandE10000007Erewash########
14DL8 3AFYes54.29027-1.99533400402488293SE004882North YorkshireRichmondshire
15EX33 1LRYes51.10743-4.16299248674136462SS486364DevonNorth DevonBraunton WestE07000043E05003537EnglandE10000008North Devon########
16EX4 2LEYes50.73842-3.5934728765594412SX876944DevonTeignbridgeTeignbridge NorthE07000045E05003610EnglandE10000008Central Devon########
17HX3 5NSYes53.73978-1.88809407479427050SE074270West YorkshireCalderdaleOvendenE08000033E05001379EnglandE11000019Halifax########
18L9 3BUYes53.45909-2.96334336134396247SJ361962MerseysideLiverpoolWarbreckE08000012E05000911EnglandE11000013Liverpool, Walton########
19LN2 1EWYes53.23045-0.53729497737371377SK977713LincolnshireLincolnAbbeyE07000138E05010784EnglandE10000019Lincoln########
20LS7 4QYYes53.8323-1.53311430826437438SE308374West YorkshireLeedsChapel AllertonE08000035E05001419EnglandE11000019Leeds North East########
21ME12 4QFYes51.400120.920474603244170835TR032708KentSwaleSheppey EastE07000113E05009562EnglandE10000016Sittingbourne and Sheppey########
22MK16 9HJYes52.09267-0.652492447244671SP924446BuckinghamshireMilton KeynesOlneyE06000042E05009418EnglandE10000002Milton Keynes North########
Sheet2


I end up with
+Fluff New.xlsm
ABCDEFGHIJKLMNOP
1AL4 0SPYes51.75121-0.28483518495207227TL184072HertfordshireSt AlbansColney HeathE07000240E05009028EnglandE10000015St Albans########
2BS25 1QHYes51.32351-2.8008344295158571ST442585SomersetSedgemoorCheddar and ShiphamE07000188E05008905EnglandE10000027Wells########
3CH1 6LNYes53.23844-2.9201338689371662SJ386716CheshireCheshire West and ChesterSaughall and MollingtonE06000050E05008692EnglandE11000004City of Chester########
4DE15 0QBYes52.79074-1.56753429261321551SK292215DerbyshireSouth DerbyshireNewhall and StantonE07000039E05008817EnglandE10000007South Derbyshire########
5DE7 5QBYes52.971-1.30972446454341738SK464417DerbyshireErewashLittle HallamE07000036E05010614EnglandE10000007Erewash########
6EX33 1LRYes51.10743-4.16299248674136462SS486364DevonNorth DevonBraunton WestE07000043E05003537EnglandE10000008North Devon########
7EX4 2LEYes50.73842-3.5934728765594412SX876944DevonTeignbridgeTeignbridge NorthE07000045E05003610EnglandE10000008Central Devon########
8HX3 5NSYes53.73978-1.88809407479427050SE074270West YorkshireCalderdaleOvendenE08000033E05001379EnglandE11000019Halifax########
9L9 3BUYes53.45909-2.96334336134396247SJ361962MerseysideLiverpoolWarbreckE08000012E05000911EnglandE11000013Liverpool, Walton########
10LN2 1EWYes53.23045-0.53729497737371377SK977713LincolnshireLincolnAbbeyE07000138E05010784EnglandE10000019Lincoln########
11LS7 4QYYes53.8323-1.53311430826437438SE308374West YorkshireLeedsChapel AllertonE08000035E05001419EnglandE11000019Leeds North East########
12ME12 4QFYes51.400120.920474603244170835TR032708KentSwaleSheppey EastE07000113E05009562EnglandE10000016Sittingbourne and Sheppey########
13MK16 9HJYes52.09267-0.652492447244671SP924446BuckinghamshireMilton KeynesOlneyE06000042E05009418EnglandE10000002Milton Keynes North########
14AL4 8EGYes51.79911-0.31607516216212503TL162125HertfordshireSt Albans
15CA10 1REYes54.68003-2.596361669531826NY616318CumbriaEden
16CT16 1PFYes51.125881.313926631983141511TR319415KentDover
17DL8 3AFYes54.29027-1.99533400402488293SE004882North YorkshireRichmondshire
Sheet1
Before & After
 

Attachments

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,756
Office Version
365
Platform
Windows
Have you changed the code at all?
 

Harshil Mehta

New Member
Joined
May 14, 2020
Messages
19
Office Version
2013
Platform
Windows
Have you changed the code at all?
VBA Code:
Sub HarshilMehta()
   Dim Ary As Variant, Nary As Variant, Nary2 As Variant
   Dim r As Long, c As Long, nr As Long, cc As Long, nr2 As Long
   Dim Flg As Boolean
  
   With Sheets(3)
      Ary = .Range("A7:AM" & .Range("D" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   ReDim Nary2(1 To UBound(Ary), 1 To UBound(Ary, 2))
   For r = 1 To UBound(Ary)
      Flg = True
      For c = 10 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            Flg = False
            nr = nr + 1
            For cc = 1 To UBound(Ary, 2)
               Nary(nr, cc) = Ary(r, cc)
            Next cc
            Exit For
         End If
      Next c
      If Flg Then
         nr2 = nr2 + 1
         For cc = 1 To UBound(Ary, 2)
            Nary2(nr2, cc) = Ary(r, cc)
         Next cc
      End If
   Next r
   Sheets(1).Range("A2").Resize(nr, UBound(Ary, 2)).Value = Nary
   Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr2, UBound(Ary, 2)).Value = Nary2
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,756
Office Version
365
Platform
Windows
Ok you have nothing in col A, which is causing the problem
use
VBA Code:
   Sheets(1).Range("D" & Rows.Count).End(xlUp).Offset(1, -3).Resize(nr2, UBound(Ary, 2)).Value = Nary2
 

Harshil Mehta

New Member
Joined
May 14, 2020
Messages
19
Office Version
2013
Platform
Windows
Ok you have nothing in col A, which is causing the problem
use
VBA Code:
   Sheets(1).Range("D" & Rows.Count).End(xlUp).Offset(1, -3).Resize(nr2, UBound(Ary, 2)).Value = Nary2
Thanks mate. I really appreciate your time and efforts. Thank you so much.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,756
Office Version
365
Platform
Windows
Glad we could help & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,095,728
Messages
5,446,174
Members
405,389
Latest member
Excel n00b2

This Week's Hot Topics

Top