Macro for combining columns and duplicating rows based on data

**abuchan** · 02-24-2011, 01:48 PM

I am attaching a sample spreadsheet which should provide a better idea of what I hope to do.

In rows 1-10 I have a sample of the data I wish to massage, and is defined as:
A: an image
B: an alternate name for the image
C: a geographic location for where the image is located, defined as Township/Range
1. The first two-digit number is a 'Township' Number. This number will always be two digits.
2. A space
3. A one or two digit number followed by a W for west or an E for east.

Update:
**Please note that this number may be provided as a single digit (ie. 4 which would result in 04) or a double digit (ie. 12 which would result in 12)** The spreadsheet has also been updated with an example of a double-digit Range.**

D: more geographic location information regarding the location of the image regarding Section.
1. The section will always be two-digits, hence 02 for section 2. This column also includes some letters (P and S) which have no meaning and will need to be deleted during the massage.
E: comments regarding the image.
Please note that the images are not included in this sample, just their names.

Rows 15-33 are what I hope to have as a result.
A: is the image name repeated from above
B: the alternate name for the image repeated from above
C: is a combination of columns C and D (rows 1-10) from above. The Township number is repeated with a 'N/' added to it. The Range number is combined with a '/' added to it. and only one of the Section numbers (two digits) is added to it. The row is then duplicated with another (different) of the section numbers. The row is duplicated as many time as there are different (two-digit) numbers in the original 'D' column (rows 1-10). (ie. Row 1 is duplicated four times and becomes rows 15-18.

I hope to have the results displayed on Sheet 2 so that the original data can be preserved for other uses.

I hope to use a Macro as this is just a sample which will be used on data which exceeds 100,000 total rows, but no more than 1,000 rows at a time.

Any help provided is appreciated.

**rylo** · 02-24-2011, 06:21 PM

Hi

Try this.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Sheet3")
  
  OutSH.Cells.ClearContents
  
  Sheets("Sheet1").Select
  
  For Each ce In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    arr = Split(ce.Offset(0, 3).Value, " ")
    
    For i = LBound(arr) To UBound(arr)
      If Len(arr(i)) > 1 Then
        outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        OutSH.Cells(outrow, 1).Value = ce.Value
        OutSH.Cells(outrow, 2).Value = ce.Offset(0, 1).Value
        OutSH.Cells(outrow, 3).Value = Left(ce.Offset(0, 2), 2) & "N/0" & Right(ce.Offset(0, 2).Value, 2) & "/" & arr(i)
        OutSH.Cells(outrow, 4).Value = ce.Offset(0, 4).Value
      End If
    Next i
  Next ce
End Sub

rylo

**abuchan** · 02-24-2011, 06:27 PM

Thank you, I wiill try it as soon as I can free up my computer. One thought: if the Range was provided as '12', would this show it as '12' or 012? (ie. 40N/12E/28 or 40N/012E/28). I just noticed that none of my rows had a two digit number for Range.

Thank you much.

**rylo** · 02-24-2011, 06:55 PM

Hi

It would be 012E. It may pay to update your example file to show a full range of possibilities in your data, and how they should be presented. I based my output on your examples provided.

rylo

**abuchan** · 02-24-2011, 07:05 PM

My apologies. I have updated the original thread to show this case. While there will only be a few with double digits, they do exist.

Thank you for your time and effort.

**rylo** · 02-24-2011, 07:54 PM

Hi

OK, here goes.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Sheet3")
  
  OutSH.Cells.ClearContents
  
  Sheets("Sheet1").Select
  
  For Each ce In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    arr = Split(ce.Offset(0, 3).Value, " ")
    
    For i = LBound(arr) To UBound(arr)
      If Len(arr(i)) > 1 Then
        outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        OutSH.Cells(outrow, 1).Value = ce.Value
        OutSH.Cells(outrow, 2).Value = ce.Offset(0, 1).Value
        If Len(ce.Offset(0, 2).Value) = 6 Then
          joiner = "N/" & Right(ce.Offset(0, 2).Value, 3)
        Else
          joiner = "N/0" & Right(ce.Offset(0, 2).Value, 2)
        End If
        
        OutSH.Cells(outrow, 3).Value = Left(ce.Offset(0, 2), 2) & joiner & "/" & arr(i)
        OutSH.Cells(outrow, 4).Value = ce.Offset(0, 4).Value
      End If
    Next i
  Next ce
End Sub

rylo

**abuchan** · 03-27-2011, 01:57 AM

I had to be away and was not able to work with this macro right away. I have done so now and it works masterfully! Unfortunately, I don't have the option of changing the thread to 'Solved', but considered done so. Thank you.