More Efficient Looping

B

bhsoundman

Board Regular
Joined
Jul 17, 2010
Messages
50
Office Version
  1. 365
Platform
  1. MacOS
Hi All,

I've pieced together this code & although the end result is exactly what I need it to do, I'm sure it's not nearly efficient or fast enough.
The basic set up is some data in column G1:AB24. Each row represents a person & the next 20 columns in that row may or may not have times. If there's a blank row in column G (no name) then that row is skipped entirely.
The version of the data without blank rows gets put into AD1:AX24.
A loop within a loop basically.
Can someone help me streamline this code? Thanks so much!

VBA Code: 
Sub copy_times()
'
Range("g1").Select
    Dim RowCount As Long
    Dim ColCount As Long
    Dim tmpstr As String
    Dim PrevCell As Range
    Dim Time1 As String
    Dim Time2 As String
    Dim Time3 As String
    Dim Time4 As String
    Dim Time5 As String
    Dim Time6 As String
    Dim Time7 As String
    Dim Time8 As String
    Dim Time9 As String
    Dim Time10 As String
    Dim Time11 As String
    Dim Time12 As String
    Dim Time13 As String
    Dim Time14 As String
    Dim Time15 As String
    Dim Time16 As String
    Dim Time17 As String
    Dim Time18 As String
    Dim Time19 As String
    Dim Time20 As String
    Set PrevCell = ActiveCell
 
    For RowCount = 1 To 25
        tmpstr = ""
        Time1 = ""

        For ColCount = 7 To 7
           tmpstr = tmpstr & Cells(RowCount, ColCount)
           Time1 = Cells(RowCount, ColCount).Offset(0, 1)
           Time2 = Cells(RowCount, ColCount).Offset(0, 2)
           Time3 = Cells(RowCount, ColCount).Offset(0, 3)
           Time4 = Cells(RowCount, ColCount).Offset(0, 4)
           Time5 = Cells(RowCount, ColCount).Offset(0, 5)
           Time6 = Cells(RowCount, ColCount).Offset(0, 6)
           Time7 = Cells(RowCount, ColCount).Offset(0, 7)
           Time8 = Cells(RowCount, ColCount).Offset(0, 8)
           Time9 = Cells(RowCount, ColCount).Offset(0, 9)
           Time10 = Cells(RowCount, ColCount).Offset(0, 10)
           Time11 = Cells(RowCount, ColCount).Offset(0, 11)
           Time12 = Cells(RowCount, ColCount).Offset(0, 12)
           Time13 = Cells(RowCount, ColCount).Offset(0, 13)
           Time14 = Cells(RowCount, ColCount).Offset(0, 14)
           Time15 = Cells(RowCount, ColCount).Offset(0, 15)
           Time16 = Cells(RowCount, ColCount).Offset(0, 16)
           Time17 = Cells(RowCount, ColCount).Offset(0, 17)
           Time18 = Cells(RowCount, ColCount).Offset(0, 18)
           Time19 = Cells(RowCount, ColCount).Offset(0, 19)
           Time20 = Cells(RowCount, ColCount).Offset(0, 20)
        Next ColCount
   

        If tmpstr <> "" Then
   
            Range("ad1").Select
        Do
   
   
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True

 ActiveCell.Select
    ActiveCell = tmpstr
    ActiveCell.Offset(0, 1) = Time1
    ActiveCell.Offset(0, 2) = Time2
    ActiveCell.Offset(0, 3) = Time3
    ActiveCell.Offset(0, 4) = Time4
    ActiveCell.Offset(0, 5) = Time5
    ActiveCell.Offset(0, 6) = Time6
    ActiveCell.Offset(0, 7) = Time7
    ActiveCell.Offset(0, 8) = Time8
    ActiveCell.Offset(0, 9) = Time9
    ActiveCell.Offset(0, 10) = Time10
    ActiveCell.Offset(0, 11) = Time11
    ActiveCell.Offset(0, 12) = Time12
    ActiveCell.Offset(0, 13) = Time13
    ActiveCell.Offset(0, 14) = Time14
    ActiveCell.Offset(0, 15) = Time15
    ActiveCell.Offset(0, 16) = Time16
    ActiveCell.Offset(0, 17) = Time17
    ActiveCell.Offset(0, 18) = Time18
    ActiveCell.Offset(0, 19) = Time19
    ActiveCell.Offset(0, 20) = Time20
   
    PrevCell.Select

    Application.CutCopyMode = False

        End If
    Next RowCount
End Sub
 
Last edited by a moderator:
Sort by date Sort by votes
MARK858 said:
Maybe it would be better if you posted some data using the boards XL2BB addin of both your cells to be copied and the end destination done manually (about 6 lines for the destination), especially as you are now stating different ranges.
Click to expand...
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Here's the minisheet that better illustrates what I'm doing.

Crew Time.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABAC
1Day 1
2NameTimeDay 1Day 2Day 3Day 4Day 5Day 6Day 7Day 8Day 9Day 10Day 11Day 12Day 13Day 14Day 15Day 16Day 17Day 18Day 19Day 20
3Name 12:00 AMName 12:00 AM10:00 AM
4Name 23:00 AMName 23:00 AM11:00 AM8:00 PM
5Name 56:00 AM
6Name 85:00 AM
7Name 102:00 PMName 56:00 AM2:00 PM9:00 PM
8Name 1110:00 PM
9Name 134:00 PM
10Name 167:00 AMName 85:00 AM
11Name 226:00 AM
12Name 102:00 PM3:00 PM11:00 PM
13Name 1110:00 PM11:00 PM
14
15Name 134:00 PM3:00 PM4:00 PM
16
17
18Name 167:00 AM7:00 PM
19
20
21Day 2
22NameTime
23Name 1<----- I'd love to skip the rows that have no times in it as well
24Name 211:00 AMName 226:00 AM9:00 PM4:00 AM
25Name 52:00 PMName 232:00 AM5:00 AM
26Name 8<----- I'd love to skip the rows that have no times in it as wellName 247:00 PM7:00 PM8:00 AM
27Name 103:00 PM
28Name 11<----- I'd love to skip the rows that have no times in it as well
29Name 133:00 PM
30Name 16<----- I'd love to skip the rows that have no times in it as well
31Name 229:00 PM
32
33
34
35
36
37
38
39
40
41Day 2
42NameTime
43Name 110:00 AM
44Name 28:00 PM
45Name 59:00 PM
46Name 8<----- I'd love to skip the rows that have no times in it as well
47Name 1011:00 PM
48Name 1111:00 PM
49Name 134:00 PM
50Name 167:00 PM
51Name 224:00 AM
52
53
54
55
Sheet1
 
Upvote 0
And here's the macro:

VBA Code: 
Sub Crew_Times()
'
Range("a3:b12,a23:b32,a43:b52").ClearContents

Range("g3").Select
    Dim RowCount As Long
    Dim ColCount As Long
    Dim tmpstr As String
    Dim PrevCell As Range
    Dim Time1 As String
    Dim Time2 As String
    Dim Time3 As String
    Dim Time4 As String
    Dim Time5 As String
    Dim Time6 As String
    Dim Time7 As String
    Dim Time8 As String
    Dim Time9 As String
    Dim Time10 As String
    Dim Time11 As String
    Dim Time12 As String
    Dim Time13 As String
    Dim Time14 As String
    Dim Time15 As String
    Dim Time16 As String
    Dim Time17 As String
    Dim Time18 As String
    Dim Time19 As String
    Dim Time20 As String
    Set PrevCell = ActiveCell
 
    For RowCount = 1 To 24
        tmpstr = ""
        Time1 = ""

        For ColCount = 7 To 7
           tmpstr = tmpstr & Cells(RowCount, ColCount)
           Time1 = Cells(RowCount, ColCount).Offset(0, 1)
           Time2 = Cells(RowCount, ColCount).Offset(0, 2)
           Time3 = Cells(RowCount, ColCount).Offset(0, 3)
           Time4 = Cells(RowCount, ColCount).Offset(0, 4)
           Time5 = Cells(RowCount, ColCount).Offset(0, 5)
           Time6 = Cells(RowCount, ColCount).Offset(0, 6)
           Time7 = Cells(RowCount, ColCount).Offset(0, 7)
           Time8 = Cells(RowCount, ColCount).Offset(0, 8)
           Time9 = Cells(RowCount, ColCount).Offset(0, 9)
           Time10 = Cells(RowCount, ColCount).Offset(0, 10)
           Time11 = Cells(RowCount, ColCount).Offset(0, 11)
           Time12 = Cells(RowCount, ColCount).Offset(0, 12)
           Time13 = Cells(RowCount, ColCount).Offset(0, 13)
           Time14 = Cells(RowCount, ColCount).Offset(0, 14)
           Time15 = Cells(RowCount, ColCount).Offset(0, 15)
           Time16 = Cells(RowCount, ColCount).Offset(0, 16)
           Time17 = Cells(RowCount, ColCount).Offset(0, 17)
           Time18 = Cells(RowCount, ColCount).Offset(0, 18)
           Time19 = Cells(RowCount, ColCount).Offset(0, 19)
           Time20 = Cells(RowCount, ColCount).Offset(0, 20)
        Next ColCount
    

        If tmpstr <> "" Then
    
            Range("a3").Select
        Do
    
    
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True

 ActiveCell.Select
    ActiveCell = tmpstr
    ActiveCell.Offset(0, 1) = Time1
    ActiveCell.Offset(20, 0) = tmpstr
    ActiveCell.Offset(20, 1) = Time2
    ActiveCell.Offset(40, 0) = tmpstr
    ActiveCell.Offset(40, 1) = Time3
    
    ' These cells would be included in the final version
    
   ' ActiveCell.Offset(60, 0) = tmpstr
   ' ActiveCell.Offset(60, 1) = Time4
   ' ActiveCell.Offset(80, 0) = tmpstr
   ' ActiveCell.Offset(80, 1) = Time5
   ' ActiveCell.Offset(100, 0) = tmpstr
   ' ActiveCell.Offset(100, 1) = Time6
   ' ActiveCell.Offset(120, 0) = tmpstr
   ' ActiveCell.Offset(120, 1) = Time7
   ' ActiveCell.Offset(140, 0) = tmpstr
   ' ActiveCell.Offset(140, 1) = Time8
   ' ActiveCell.Offset(160, 0) = tmpstr
   ' ActiveCell.Offset(160, 1) = Time9
   ' ActiveCell.Offset(200, 0) = tmpstr
   ' ActiveCell.Offset(200, 1) = Time10
   ' ActiveCell.Offset(200, 0) = tmpstr
   ' ActiveCell.Offset(220, 1) = Time11
   ' ActiveCell.Offset(240, 0) = tmpstr
   ' ActiveCell.Offset(240, 1) = Time12
   ' ActiveCell.Offset(280, 0) = tmpstr
   ' ActiveCell.Offset(280, 1) = Time13
   ' ActiveCell.Offset(320, 0) = tmpstr
   ' ActiveCell.Offset(320, 1) = Time14
   ' ActiveCell.Offset(360, 0) = tmpstr
   ' ActiveCell.Offset(360, 1) = Time15
   ' ActiveCell.Offset(400, 0) = tmpstr
   ' ActiveCell.Offset(400, 1) = Time16
   ' ActiveCell.Offset(420, 0) = tmpstr
   ' ActiveCell.Offset(420, 1) = Time17
   ' ActiveCell.Offset(460, 0) = tmpstr
   ' ActiveCell.Offset(460, 1) = Time18
   ' ActiveCell.Offset(500, 0) = tmpstr
   ' ActiveCell.Offset(500, 1) = Time19
   ' ActiveCell.Offset(520, 0) = tmpstr
   ' ActiveCell.Offset(520, 1) = Time20
    
    PrevCell.Select

    Application.CutCopyMode = False

        End If
    Next RowCount
End Sub
 
Upvote 0
DanteAmor said:
According to your macro the destination is NOT in different ranges.

Then explain how you determine which source cell range goes to which destination cell range.
If you explain it with examples, as Mark commented, we can help you simplify your macro.

🧙‍♂️
Click to expand...
Just posted a minisheet with the revised code
 
Upvote 0
Check the next option. It automatically adjusts to the number of names and days.
According to your minisheet, the data starts in cell G3 onwards.

Try this:
VBA Code: 
Sub copy_times_v1()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, col As Long, k As Long
  Dim rng As Range
  
  'Store the values in array 'a'
  a = Range("G2", Cells(Range("G" & Rows.Count).End(3).Row, Cells(2, Columns.Count).End(1).Column)).Value
  'Resize the output array
  ReDim b(1 To (UBound(a, 1) * UBound(a, 2)) + (UBound(a, 2) * 2), 1 To 2)
  
  'Clear columns A:B
  Range("A:B").Clear
  Range("B:B").NumberFormat = "hh:mm AM/PM"
  Set rng = Range("A1:B1")
  
  col = Columns("G").Column
  k = 1
  
  'Go through the columns (days)
  For j = 2 To UBound(a, 2)
    col = col + 1
    If WorksheetFunction.CountA(Columns(col)) > 1 Then
      b(k, 1) = a(1, j)
      b(k + 1, 1) = "Name"
      b(k + 1, 2) = "Time"
      Set rng = Union(rng, Range("A" & k & ":B" & k + 1))
      k = k + 2
      
      'Go through the rows (names)
      For i = 2 To UBound(a, 1)
        If a(i, 1) <> "" And a(i, j) <> "" Then
          b(k, 1) = a(i, 1)
          b(k, 2) = a(i, j)
          k = k + 1
        End If
      Next
      k = k + 1
    End If
  Next
  
  Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  rng.Interior.Color = 15716082
End Sub

🤗
 
Upvote 0
DanteAmor said:
Check the next option. It automatically adjusts to the number of names and days.
According to your minisheet, the data starts in cell G3 onwards.

Try this:
VBA Code: 
Sub copy_times_v1()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, col As Long, k As Long
  Dim rng As Range
 
  'Store the values in array 'a'
  a = Range("G2", Cells(Range("G" & Rows.Count).End(3).Row, Cells(2, Columns.Count).End(1).Column)).Value
  'Resize the output array
  ReDim b(1 To (UBound(a, 1) * UBound(a, 2)) + (UBound(a, 2) * 2), 1 To 2)
 
  'Clear columns A:B
  Range("A:B").Clear
  Range("B:B").NumberFormat = "hh:mm AM/PM"
  Set rng = Range("A1:B1")
 
  col = Columns("G").Column
  k = 1
 
  'Go through the columns (days)
  For j = 2 To UBound(a, 2)
    col = col + 1
    If WorksheetFunction.CountA(Columns(col)) > 1 Then
      b(k, 1) = a(1, j)
      b(k + 1, 1) = "Name"
      b(k + 1, 2) = "Time"
      Set rng = Union(rng, Range("A" & k & ":B" & k + 1))
      k = k + 2
     
      'Go through the rows (names)
      For i = 2 To UBound(a, 1)
        If a(i, 1) <> "" And a(i, j) <> "" Then
          b(k, 1) = a(i, 1)
          b(k, 2) = a(i, j)
          k = k + 1
        End If
      Next
      k = k + 1
    End If
  Next
 
  Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  rng.Interior.Color = 15716082
End Sub

🤗
Click to expand...

It's beautiful! works perfectly! Thanks so much for your help. A lot of info for me to learn from. Thank you for your time & expertise!
 
Upvote 0
DanteAmor said:
Check the next option. It automatically adjusts to the number of names and days.
According to your minisheet, the data starts in cell G3 onwards.

Try this:
VBA Code: 
Sub copy_times_v1()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, col As Long, k As Long
  Dim rng As Range
 
  'Store the values in array 'a'
  a = Range("G2", Cells(Range("G" & Rows.Count).End(3).Row, Cells(2, Columns.Count).End(1).Column)).Value
  'Resize the output array
  ReDim b(1 To (UBound(a, 1) * UBound(a, 2)) + (UBound(a, 2) * 2), 1 To 2)
 
  'Clear columns A:B
  Range("A:B").Clear
  Range("B:B").NumberFormat = "hh:mm AM/PM"
  Set rng = Range("A1:B1")
 
  col = Columns("G").Column
  k = 1
 
  'Go through the columns (days)
  For j = 2 To UBound(a, 2)
    col = col + 1
    If WorksheetFunction.CountA(Columns(col)) > 1 Then
      b(k, 1) = a(1, j)
      b(k + 1, 1) = "Name"
      b(k + 1, 2) = "Time"
      Set rng = Union(rng, Range("A" & k & ":B" & k + 1))
      k = k + 2
    
      'Go through the rows (names)
      For i = 2 To UBound(a, 1)
        If a(i, 1) <> "" And a(i, j) <> "" Then
          b(k, 1) = a(i, 1)
          b(k, 2) = a(i, j)
          k = k + 1
        End If
      Next
      k = k + 1
    End If
  Next
 
  Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  rng.Interior.Color = 15716082
End Sub

🤗
Click to expand...

Hi DanteAmor,

So I was making some adjustments last night & I keep running into a couple of snags. Apparently I'm not following what all you're doing.

I'm basically trying to make each day have 4 columns (Name, Time 1, Time 2, & Notes. I've been able to make some adjustments correctly, but then I mee something else up.

I hate to bug you again, but would you mind pointing me in the right direction. Here's a minisheet that I did manually that shows what I'm attempting to do.

Thanks in advance!

Crew Time b.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKAL
1Day 1
2NameTime 1Time 2NotesDay 1Day 2Day 3Day 4Day 5Day 6Day 7Day 8Day 9Day 10
3Name13:00 AMDay 1 notesName13:00 AMDay 1 notes6:00 AMDay 2 Notes
4Name21:00 AMDay 1 notesName21:00 AMDay 1 notes8:00 AM
5Name32:00 AMName32:00 AM2:00 AM
6Name54:00 AMName43:00 AM6:00 AM
7Name65:00 AMName54:00 AM
8Name74:00 AMName65:00 AM
9Name87:00 AMName74:00 AM9:00 AMDay 2 Notes
10Name98:00 AMName87:00 AM5:00 AM
11Name109:00 AMName98:00 AM
12Name1211:00 AMName109:00 AM
13Name119:00 AM
14Day 2Name12########
15NameTime InTime OutNotesName13
16Name16:00 AMDay 2 NotesName14
17Name28:00 AMName15
18Name32:00 AMName16
19Name43:00 AM6:00 AMName17
20Name79:00 AMDay 2 NotesName18
21Name85:00 AMName19
22Name119:00 AMName20
23Name21
24Name22
25Name23
26Name24
27
28
Sheet1
 
Upvote 0
bhsoundman said:
Hi DanteAmor,

So I was making some adjustments last night & I keep running into a couple of snags. Apparently I'm not following what all you're doing.

I'm basically trying to make each day have 4 columns (Name, Time 1, Time 2, & Notes. I've been able to make some adjustments correctly, but then I mee something else up.

I hate to bug you again, but would you mind pointing me in the right direction. Here's a minisheet that I did manually that shows what I'm attempting to do.

Thanks in advance!

Crew Time b.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKAL
1Day 1
2NameTime 1Time 2NotesDay 1Day 2Day 3Day 4Day 5Day 6Day 7Day 8Day 9Day 10
3Name13:00 AMDay 1 notesName13:00 AMDay 1 notes6:00 AMDay 2 Notes
4Name21:00 AMDay 1 notesName21:00 AMDay 1 notes8:00 AM
5Name32:00 AMName32:00 AM2:00 AM
6Name54:00 AMName43:00 AM6:00 AM
7Name65:00 AMName54:00 AM
8Name74:00 AMName65:00 AM
9Name87:00 AMName74:00 AM9:00 AMDay 2 Notes
10Name98:00 AMName87:00 AM5:00 AM
11Name109:00 AMName98:00 AM
12Name1211:00 AMName109:00 AM
13Name119:00 AM
14Day 2Name12########
15NameTime InTime OutNotesName13
16Name16:00 AMDay 2 NotesName14
17Name28:00 AMName15
18Name32:00 AMName16
19Name43:00 AM6:00 AMName17
20Name79:00 AMDay 2 NotesName18
21Name85:00 AMName19
22Name119:00 AMName20
23Name21
24Name22
25Name23
26Name24
27
28
Sheet1
Click to expand...

Small mistake. Day 2 header should be the same as Day 1 (Name, Time 1, Time 2, Notes)
 
Upvote 0
bhsoundman said:
I'm basically trying to make each day have 4 columns (Name, Time 1, Time 2, & Notes.
Click to expand...

Try this:

VBA Code: 
Sub copy_times_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, col As Long, k As Long, lr As Long
  Dim rng As Range
  
  'Store the values in array 'a'
  lr = Range("G" & Rows.Count).End(3).Row
  a = Range("G2", Cells(lr, Cells(2, Columns.Count).End(1).Column)).Value
  'Resize the output array
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) / 3)) + (UBound(a, 2) * 2), 1 To 4)
  
  'Clear columns A:C
  Range("A:C").Clear
  Range("B:C").NumberFormat = "hh:mm AM/PM"
  Set rng = Range("A1:D1")
  
  col = Columns("H").Column
  k = 1
  
  'Go through the columns (days)
  For j = 2 To UBound(a, 2) Step 3
    If WorksheetFunction.CountA(Range(Cells(2, col), Cells(lr, col + 2))) > 1 Then
      b(k, 1) = a(1, j)
      b(k + 1, 1) = "Name"
      b(k + 1, 2) = "Time 1"
      b(k + 1, 3) = "Time 2"
      b(k + 1, 4) = "Notes"
      Set rng = Union(rng, Range("A" & k & ":D" & k + 1))
      k = k + 2
      
      'Go through the rows (names)
      For i = 2 To UBound(a, 1)
        If a(i, 1) <> "" Then
          If a(i, j) <> "" Or a(i, j + 1) <> "" Or a(i, j + 2) <> "" Then
            b(k, 1) = a(i, 1)
            b(k, 2) = a(i, j)
            b(k, 3) = a(i, j + 1)
            b(k, 4) = a(i, j + 2)
            k = k + 1
          End If
        End If
      Next
      k = k + 1
    End If
    col = col + 3
  Next
  
  Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  rng.Interior.Color = 15716082
End Sub

😇
 
Upvote 0
Solution
DanteAmor said:
Try this:

VBA Code: 
Sub copy_times_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, col As Long, k As Long, lr As Long
  Dim rng As Range
 
  'Store the values in array 'a'
  lr = Range("G" & Rows.Count).End(3).Row
  a = Range("G2", Cells(lr, Cells(2, Columns.Count).End(1).Column)).Value
  'Resize the output array
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) / 3)) + (UBound(a, 2) * 2), 1 To 4)
 
  'Clear columns A:C
  Range("A:C").Clear
  Range("B:C").NumberFormat = "hh:mm AM/PM"
  Set rng = Range("A1:D1")
 
  col = Columns("H").Column
  k = 1
 
  'Go through the columns (days)
  For j = 2 To UBound(a, 2) Step 3
    If WorksheetFunction.CountA(Range(Cells(2, col), Cells(lr, col + 2))) > 1 Then
      b(k, 1) = a(1, j)
      b(k + 1, 1) = "Name"
      b(k + 1, 2) = "Time 1"
      b(k + 1, 3) = "Time 2"
      b(k + 1, 4) = "Notes"
      Set rng = Union(rng, Range("A" & k & ":D" & k + 1))
      k = k + 2
     
      'Go through the rows (names)
      For i = 2 To UBound(a, 1)
        If a(i, 1) <> "" Then
          If a(i, j) <> "" Or a(i, j + 1) <> "" Or a(i, j + 2) <> "" Then
            b(k, 1) = a(i, 1)
            b(k, 2) = a(i, j)
            b(k, 3) = a(i, j + 1)
            b(k, 4) = a(i, j + 2)
            k = k + 1
          End If
        End If
      Next
      k = k + 1
    End If
    col = col + 3
  Next
 
  Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  rng.Interior.Color = 15716082
End Sub

😇
Click to expand...

It works perfectly. Thank you again for your time & assistance! I see where I was going wrong.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
user form Check box, recheck with code
Replies
3
Views
2K
Mikal
M
M
  • Question Question
Problem deleting column from multiple sheets
Replies
6
Views
748
Mindpsyche
M

Forum statistics

Threads
1,224,557
Messages
6,179,508
Members
452,918
Latest member
Davion615

Share this page

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
Back
Top