Macro to copy & paste range

Alex O

Alex O

Active Member
Joined
Mar 16, 2009
Messages
345
Office Version
  1. 365
Platform
  1. Windows
Can anyone help with a macro that will copy K&I and paste the values into AH so that it's formatted as VSB/09-2375.40.<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 77px"><COL style="WIDTH: 153px"><COL style="WIDTH: 152px"><COL style="WIDTH: 68px"><COL style="WIDTH: 67px"><COL style="WIDTH: 40px"><COL style="WIDTH: 74px"><COL style="WIDTH: 77px"><COL style="WIDTH: 82px"><COL style="WIDTH: 63px"><COL style="WIDTH: 72px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD><TD>G</TD><TD>H</TD><TD>I</TD><TD>J</TD><TD>K</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: left">120499</TD><TD style="TEXT-ALIGN: left">A-1 Asphalt Driveways</TD><TD style="TEXT-ALIGN: left">9233 Bayberry Ave</TD><TD> </TD><TD style="TEXT-ALIGN: left">Manassas</TD><TD style="TEXT-ALIGN: left">VA</TD><TD style="TEXT-ALIGN: left">20110</TD><TD style="TEXT-ALIGN: left">7033854154</TD><TD style="TEXT-ALIGN: left">2,375.40</TD><TD style="TEXT-ALIGN: left">01/10/11</TD><TD style="TEXT-ALIGN: left">VSB/09</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: left">202609</TD><TD style="TEXT-ALIGN: left">Knotts Interiors Inc</TD><TD style="TEXT-ALIGN: left">1505 N Hermitage Rd</TD><TD> </TD><TD style="TEXT-ALIGN: left">Hermitage</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">16148-3104</TD><TD style="TEXT-ALIGN: left">7249625766</TD><TD style="TEXT-ALIGN: left">1,356.25</TD><TD style="TEXT-ALIGN: left">12/16/10</TD><TD style="TEXT-ALIGN: left">LMW/09</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: left">202609</TD><TD style="TEXT-ALIGN: left">Knotts Interiors Inc</TD><TD style="TEXT-ALIGN: left">1505 N Hermitage Rd</TD><TD> </TD><TD style="TEXT-ALIGN: left">Hermitage</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">16148-3104</TD><TD style="TEXT-ALIGN: left">7249625766</TD><TD style="TEXT-ALIGN: left">1,356.25</TD><TD style="TEXT-ALIGN: left">12/16/10</TD><TD style="TEXT-ALIGN: left">LMW/10</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: left">203896</TD><TD style="TEXT-ALIGN: left">David Tours & Travel</TD><TD style="TEXT-ALIGN: left">14005 McNaulty Rd</TD><TD> </TD><TD style="TEXT-ALIGN: left">Philadelphia</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">19154</TD><TD style="TEXT-ALIGN: left">8888442540</TD><TD style="TEXT-ALIGN: left">805.50</TD><TD style="TEXT-ALIGN: left">10/07/10</TD><TD style="TEXT-ALIGN: left">LMK/10</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: left">203896</TD><TD style="TEXT-ALIGN: left">David Tours & Travel</TD><TD style="TEXT-ALIGN: left">14005 McNaulty Rd</TD><TD> </TD><TD style="TEXT-ALIGN: left">Philadelphia</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">19154</TD><TD style="TEXT-ALIGN: left">8888442540</TD><TD style="TEXT-ALIGN: left">805.50</TD><TD style="TEXT-ALIGN: left">10/07/10</TD><TD style="TEXT-ALIGN: left">MSF/11</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: left">229479</TD><TD style="TEXT-ALIGN: left">K & A Auto Salvage Inc</TD><TD style="TEXT-ALIGN: left">2160-66 E Somerset St</TD><TD> </TD><TD style="TEXT-ALIGN: left">Philadelphia</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">19134-3926</TD><TD style="TEXT-ALIGN: left">2154234255</TD><TD style="TEXT-ALIGN: left">2,351.50</TD><TD style="TEXT-ALIGN: left">08/31/09</TD><TD style="TEXT-ALIGN: left">PHM/10</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="TEXT-ALIGN: left">233149</TD><TD style="TEXT-ALIGN: left">Champion Granite</TD><TD style="TEXT-ALIGN: left">1426 Millett St</TD><TD> </TD><TD style="TEXT-ALIGN: left">Dunmore</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">18512-2626</TD><TD style="TEXT-ALIGN: left">5708404176</TD><TD style="TEXT-ALIGN: left">1,548.00</TD><TD style="TEXT-ALIGN: left">08/10/10</TD><TD style="TEXT-ALIGN: left">SCM/11</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="TEXT-ALIGN: left">248311</TD><TD style="TEXT-ALIGN: left">Evergreen Trailer Sales Inc</TD><TD style="TEXT-ALIGN: left">569 S Erie St</TD><TD> </TD><TD style="TEXT-ALIGN: left">Mercer</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">16137-4101</TD><TD style="TEXT-ALIGN: left">7246623570</TD><TD style="TEXT-ALIGN: left">9,268.71</TD><TD style="TEXT-ALIGN: left">02/28/11</TD><TD style="TEXT-ALIGN: left">PIM/10</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</TD><TD style="TEXT-ALIGN: left">248311</TD><TD style="TEXT-ALIGN: left">Evergreen Trailer Sales Inc</TD><TD style="TEXT-ALIGN: left">569 S Erie St</TD><TD> </TD><TD style="TEXT-ALIGN: left">Mercer</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">16137-4101</TD><TD style="TEXT-ALIGN: left">7246623570</TD><TD style="TEXT-ALIGN: left">9,268.71</TD><TD style="TEXT-ALIGN: left">02/28/11</TD><TD style="TEXT-ALIGN: left">BNP/10</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</TD><TD style="TEXT-ALIGN: left">248311</TD><TD style="TEXT-ALIGN: left">Evergreen Trailer Sales Inc</TD><TD style="TEXT-ALIGN: left">569 S Erie St</TD><TD> </TD><TD style="TEXT-ALIGN: left">Mercer</TD><TD style="TEXT-ALIGN: left">PA</TD><TD style="TEXT-ALIGN: left">16137-4101</TD><TD style="TEXT-ALIGN: left">7246623570</TD><TD style="TEXT-ALIGN: left">9,268.71</TD><TD style="TEXT-ALIGN: left">02/28/11</TD><TD style="TEXT-ALIGN: left">LMW/11</TD></TR></TBODY></TABLE>
<TABLE style="BORDER-BOTTOM-STYLE: groove; BORDER-BOTTOM-COLOR: #00ff00; BORDER-RIGHT-STYLE: groove; BACKGROUND-COLOR: #fffcf9; BORDER-TOP-COLOR: #00ff00; FONT-FAMILY: Arial; BORDER-TOP-STYLE: groove; COLOR: #000000; BORDER-RIGHT-COLOR: #00ff00; FONT-SIZE: 10pt; BORDER-LEFT-STYLE: groove; BORDER-LEFT-COLOR: #00ff00"><TBODY><TR><TD>Spreadsheet Formulas</TD></TR><TR><TD><TABLE style="FONT-FAMILY: Arial; FONT-SIZE: 9pt" border=1 cellSpacing=0 cellPadding=2><TBODY><TR style="BACKGROUND-COLOR: #cacaca; FONT-SIZE: 10pt"><TD>Cell</TD><TD>Formula</TD></TR><TR><TD>A5</TD><TD>=IF('Step 1 Raw Data'!A3="","",'Step 1 Raw Data'!A3)</TD></TR><TR><TD>B5</TD><TD>=IF('Step 1 Raw Data'!B3="","",TRIM('Step 1 Raw Data'!B3))</TD></TR><TR><TD>C5</TD><TD>=IF('Step 1 Raw Data'!C3="","",TRIM('Step 1 Raw Data'!C3))</TD></TR><TR><TD>D5</TD><TD>=IF('Step 1 Raw Data'!D3="","",TRIM('Step 1 Raw Data'!D3))</TD></TR><TR><TD>E5</TD><TD>=IF('Step 1 Raw Data'!E3="","",TRIM('Step 1 Raw Data'!E3))</TD></TR><TR><TD>F5</TD><TD>=IF('Step 1 Raw Data'!F3="","",TRIM('Step 1 Raw Data'!F3))</TD></TR><TR><TD>G5</TD><TD>=IF('Step 1 Raw Data'!G3="","",TRIM('Step 1 Raw Data'!G3))</TD></TR><TR><TD>H5</TD><TD>=IF('Step 1 Raw Data'!H3="","",TRIM('Step 1 Raw Data'!H3))</TD></TR><TR><TD>I5</TD><TD>=IF('Step 1 Raw Data'!I3="","",TRIM('Step 1 Raw Data'!I3))*1</TD></TR><TR><TD>J5</TD><TD>=IF('Step 1 Raw Data'!J3="","",TRIM('Step 1 Raw Data'!J3))*1</TD></TR><TR><TD>K5</TD><TD>=IF('Step 1 Raw Data'!K3="","",TRIM('Step 1 Raw Data'!K3))</TD></TR></TBODY></TABLE></TD></TR></TBODY></TABLE>
 
Sort by date Sort by votes
Alex O,

Is there a title in cell B4?


Excel Workbook
B
4Title?????
5A-1 Asphalt Driveways
6Knotts Interiors Inc
7Knotts Interiors Inc
8David Tours & Travel
9David Tours & Travel
10K & A Auto Salvage Inc
11Champion Granite
12Evergreen Trailer Sales Inc
13Evergreen Trailer Sales Inc
14Evergreen Trailer Sales Inc
15
Sheet1
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Alex O,


Sample raw data before the macro (columns hidden for brevity):


Excel Workbook
ABIKLAIAJ
4Client Name
5120499A-1 Asphalt Driveways2,375.40VSB/09
6202609Knotts Interiors Inc1,356.25LMW/09
7202609Knotts Interiors Inc1,356.25LMW/10
8203896David Tours & Travel805.5LMK/10
9203896David Tours & Travel805.5MSF/11
10229479K & A Auto Salvage Inc2,351.50PHM/10
11233149Champion Granite1,548.00SCM/11
12248311Evergreen Trailer Sales Inc9,268.71PIM/10
13248311Evergreen Trailer Sales Inc9,268.71BNP/10
14248311Evergreen Trailer Sales Inc9,268.71LMW/11
15
Sheet1





After the macro:


Excel Workbook
ABIKLAIAJ
4Client Name
5120499A-1 Asphalt Driveways2,375.40VSB/09A-1 Asphalt DrivewaysVSB/09-2375.40
6202609Knotts Interiors Inc1,356.25LMW/09Knotts Interiors IncLMW/09-1356.25, LMW/10-1356.25
7202609Knotts Interiors Inc1,356.25LMW/10David Tours & TravelLMK/10-805.50, MSF/11-805.50
8203896David Tours & Travel805.5LMK/10K & A Auto Salvage IncPHM/10-2351.50
9203896David Tours & Travel805.5MSF/11Champion GraniteSCM/11-1548.00
10229479K & A Auto Salvage Inc2,351.50PHM/10Evergreen Trailer Sales IncPIM/10-9268.71, BNP/10-9268.71, LMW/11-9268.71
11233149Champion Granite1,548.00SCM/11
12248311Evergreen Trailer Sales Inc9,268.71PIM/10
13248311Evergreen Trailer Sales Inc9,268.71BNP/10
14248311Evergreen Trailer Sales Inc9,268.71LMW/11
15
Sheet1





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code: 
Option Explicit
Sub ConcatData()
' hiker95, 04/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=541381
Dim LR As Long, LR2 As Long, a As Long, aa As Long, SR As Long, ER As Long, H As String, rng As Range
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "B").End(xlUp).Row
Range("AI4:AL" & LR).ClearContents
'Set rng = Range("B5:B" & LR)
Range("B4:B" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AI4"), Unique:=True
Range("AI4").ClearContents
LR2 = Cells(Rows.Count, "AI").End(xlUp).Row
Range("AK5").Formula = "=MATCH(AI5,B:B,0)"
Range("AK5").AutoFill Destination:=Range("AK5:AK" & LR2)
Range("AL5").Formula = "=AK6-1"
Range("AL5").AutoFill Destination:=Range("AL5:AL" & LR2 - 1)
Range("AL" & LR2) = LR
For a = 5 To LR2 Step 1
  SR = Range("AK" & a).Value
  ER = Range("AL" & a).Value
  H = ""
  For aa = SR To ER Step 1
    H = H & Cells(aa, "K") & "-" & Application.Text(Cells(aa, "I"), "#00.00") & ", "
  Next aa
  If Right(H, 2) = ", " Then H = Left(H, Len(H) - 2)
  Range("AJ" & a) = H
Next a
Range("AK5:AL" & LR2).ClearContents
Columns("AI:AJ").AutoFit
Range("AI4").Select
Application.ScreenUpdating = True
End Sub


Then run the ConcatData macro.
 
Upvote 0
Incredible!!!!! That’s exactly what I was hoping for.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
Thanks for your time and expertise!<o:p></o:p>

-Alex
 
Upvote 0
Hiker95 <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
Due to some column additions, I made a couple of minor changes to the ranges. What I didn’t notice until this morning is the macro is pasting the sum of the multiple entries rather than the individual amounts. For example: <o:p></o:p>
Knotts Interiors Inc LMW/09-1356.25, LMW/10-1356.25<o:p></o:p>
Should be <o:p></o:p>
Knotts Interiors Inc LMW/09-38.50, LMW/10-1317.75.<o:p></o:p>
Is this difficult to correct?<o:p></o:p>

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 290px"><COL style="WIDTH: 81px"><COL style="WIDTH: 121px"><COL style="WIDTH: 79px"><COL style="WIDTH: 247px"><COL style="WIDTH: 352px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>AF</TD><TD>AH</TD><TD>AI</TD><TD>AJ</TD><TD>AK</TD><TD>AL</TD></TR><TR style="HEIGHT: 57px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #00ccff; FONT-WEIGHT: bold">Original List</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #00ccff; FONT-WEIGHT: bold">REFERENCE # *Values Only</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #00ccff; FONT-WEIGHT: bold">Book/Year-Account Write-off Total</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #00ccff; FONT-WEIGHT: bold">Line Item Totals</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-WEIGHT: bold">Macro Output Area</TD><TD style="FONT-WEIGHT: bold"> </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: left">A-1 Asphalt Driveways</TD><TD style="TEXT-ALIGN: left">120499</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">VSB/09-2375.4</TD><TD style="TEXT-ALIGN: left">2,375.40</TD><TD style="TEXT-ALIGN: left">A-1 Asphalt Driveways</TD><TD style="TEXT-ALIGN: left">VSB/09-2375.40</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: left">Knotts Interiors Inc</TD><TD style="TEXT-ALIGN: left">202609</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">LMW/09-38.5</TD><TD style="TEXT-ALIGN: left">38.50</TD><TD style="TEXT-ALIGN: left">Knotts Interiors Inc</TD><TD style="TEXT-ALIGN: left">LMW/09-1356.25, LMW/10-1356.25</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: left">Knotts Interiors Inc</TD><TD style="TEXT-ALIGN: left">202609</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">LMW/10-1317.75</TD><TD style="TEXT-ALIGN: left">1,317.75</TD><TD style="TEXT-ALIGN: left">David Tours & Travel</TD><TD style="TEXT-ALIGN: left">LMK/10-805.50, MSF/11-805.50</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: left">David Tours & Travel</TD><TD style="TEXT-ALIGN: left">203896</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">LMK/10-322</TD><TD style="TEXT-ALIGN: left">322.00</TD><TD style="TEXT-ALIGN: left">K & A Auto Salvage Inc</TD><TD style="TEXT-ALIGN: left">PHM/10-2351.50</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: left">David Tours & Travel</TD><TD style="TEXT-ALIGN: left">203896</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">MSF/11-483.5</TD><TD style="TEXT-ALIGN: left">483.50</TD><TD style="TEXT-ALIGN: left">Champion Granite</TD><TD style="TEXT-ALIGN: left">SCM/11-1548.00</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: left">K & A Auto Salvage Inc</TD><TD style="TEXT-ALIGN: left">229479</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">PHM/10-2351.5</TD><TD style="TEXT-ALIGN: left">2,351.50</TD><TD style="TEXT-ALIGN: left">Evergreen Trailer Sales Inc</TD><TD style="TEXT-ALIGN: left">PIM/10-9268.71, BNP/10-9268.71, LMW/11-9268.71</TD></TR></TBODY></TABLE>

This is the edited macro
Sub ConcatData()
' hiker95, 04/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=541381

Dim LR As Long, LR2 As Long, a As Long, aa As Long, SR As Long, ER As Long, H As String, rng As Range
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "B").End(xlUp).Row
Range("AK4:AN" & LR).ClearContents
'Set rng = Range("B5:B" & LR)
Range("B4:B" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AK4"), Unique:=True
Range("AK4").ClearContents
LR2 = Cells(Rows.Count, "AK").End(xlUp).Row
Range("AM5").Formula = "=MATCH(AK5,B:B,0)"
Range("AM5").AutoFill Destination:=Range("AM5:AM" & LR2)
Range("AN5").Formula = "=AM6-1"
Range("AN5").AutoFill Destination:=Range("AN5:AN" & LR2 - 1)
Range("AN" & LR2) = LR
For a = 5 To LR2 Step 1
SR = Range("AM" & a).Value
ER = Range("AN" & a).Value
H = ""
For aa = SR To ER Step 1
H = H & Cells(aa, "K") & "-" & Application.Text(Cells(aa, "I"), "#00.00") & ", "
Next aa
If Right(H, 2) = ", " Then H = Left(H, Len(H) - 2)
Range("AL" & a) = H
Next a
Range("AM5:AN" & LR2).ClearContents
Columns("AK:AL").AutoFit
Range("AK4").Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Alex O,


I am starting to get confused as to where the actual data is that the macro will be running against.


One last try - can I have a screenshot of the actual data that the macro will be running against, and a screenshot of where the macro results will be, manually formatted by you.


Is your latest screenshot the area where the macro will get its data from, and range AK5:Al.... is the macro result area?
 
Last edited:
Upvote 0
Alex O,


Sample raw data before the macro:


Excel Workbook
AFAHAIAJAKAL
4Original ListREFERENCE # *Values OnlyBook/Year-Account Write-off TotalLine Item Totals
5A-1 Asphalt Driveways120499VSB/09-2375.42,375.40
6Knotts Interiors Inc202609LMW/09-38.538.50
7Knotts Interiors Inc202609LMW/10-1317.751,317.75
8David Tours & Travel203896LMK/10-322322.00
9David Tours & Travel203896MSF/11-483.5483.50
10K & A Auto Salvage Inc229479PHM/10-2351.52,351.50
11
Sheet1





After the macro:


Excel Workbook
AFAHAIAJAKAL
4Original ListREFERENCE # *Values OnlyBook/Year-Account Write-off TotalLine Item Totals
5A-1 Asphalt Driveways120499VSB/09-2375.42,375.40A-1 Asphalt DrivewaysVSB/09-2375.4-2375.40
6Knotts Interiors Inc202609LMW/09-38.538.50Knotts Interiors IncLMW/09-38.5-38.50, LMW/10-1317.75-1317.75
7Knotts Interiors Inc202609LMW/10-1317.751,317.75David Tours & TravelLMK/10-322-322.00, MSF/11-483.5-483.50
8David Tours & Travel203896LMK/10-322322.00K & A Auto Salvage IncPHM/10-2351.5-2351.50
9David Tours & Travel203896MSF/11-483.5483.50
10K & A Auto Salvage Inc229479PHM/10-2351.52,351.50
11
Sheet1





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code: 
Option Explicit
Sub ConcatDataV2()
' hiker95, 04/06/2011
' http://www.mrexcel.com/forum/showthread.php?t=541381
Dim LR As Long, LR2 As Long, a As Long, aa As Long, SR As Long, ER As Long, H As String
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "AF").End(xlUp).Row
Range("AK4:AN" & LR).ClearContents
Range("AF4:AF" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AK4"), Unique:=True
Range("AK4").ClearContents
LR2 = Cells(Rows.Count, "AK").End(xlUp).Row
Range("AM5").Formula = "=MATCH(AK5,AF:AF,0)"
Range("AM5").AutoFill Destination:=Range("AM5:AM" & LR2)
Range("AN5").Formula = "=AM6-1"
Range("AN5").AutoFill Destination:=Range("AN5:AN" & LR2 - 1)
Range("AN" & LR2) = LR
For a = 5 To LR2 Step 1
  SR = Range("AM" & a).Value
  ER = Range("AN" & a).Value
  H = ""
  For aa = SR To ER Step 1
    H = H & Cells(aa, "AI") & "-" & Application.Text(Cells(aa, "AJ"), "#00.00") & ", "
  Next aa
  If Right(H, 2) = ", " Then H = Left(H, Len(H) - 2)
  Range("AL" & a) = H
Next a
Range("AM5:AN" & LR2).ClearContents
Columns("AK:AL").AutoFit
Range("AK4").Select
Application.ScreenUpdating = True
End Sub


Then run the ConcatDataV2 macro.
 
Upvote 0
I apologize for the confusion….I have two issues that keep colliding; my inexperience with macros, and a manager who’s request keeps changing. I really appreciate your assistance. That said, as it’s constructed now, the macro should scan AF5:AF Copy and paste unique entries to AK. Then scan AI and copy and paste each corresponding string in AL. Here’s what I would like it to look like….<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p> </o:p>
Thanks Again <o:p></o:p>


<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 190px"><COL style="WIDTH: 81px"><COL style="WIDTH: 121px"><COL style="WIDTH: 79px"><COL style="WIDTH: 236px"><COL style="WIDTH: 346px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>AF</TD><TD>AH</TD><TD>AI</TD><TD>AJ</TD><TD>AK</TD><TD>AL</TD></TR><TR style="HEIGHT: 57px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #00ccff; FONT-WEIGHT: bold">Original List</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #00ccff; FONT-WEIGHT: bold">REFERENCE # *Values Only</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #00ccff; FONT-WEIGHT: bold">Book/Year-Account Write-off Total</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #00ccff; FONT-WEIGHT: bold">Line Item Totals</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-WEIGHT: bold">This is how the desired output should look….</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-WEIGHT: bold">This is how the desired output should look….</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: left">A-1 Asphalt Driveways</TD><TD style="TEXT-ALIGN: left">120499</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">VSB/09-2375.4</TD><TD style="TEXT-ALIGN: left">2,375.40</TD><TD style="TEXT-ALIGN: left">A-1 Asphalt Driveways</TD><TD style="TEXT-ALIGN: left">VSB/09-2375.4</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: left">Knotts Interiors Inc</TD><TD style="TEXT-ALIGN: left">202609</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">LMW/09-38.5</TD><TD style="TEXT-ALIGN: left">38.50</TD><TD style="TEXT-ALIGN: left">Knotts Interiors Inc</TD><TD style="TEXT-ALIGN: left">LMW/09-38.5, LMW/10-1317.75</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: left">Knotts Interiors Inc</TD><TD style="TEXT-ALIGN: left">202609</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">LMW/10-1317.75</TD><TD style="TEXT-ALIGN: left">1,317.75</TD><TD style="TEXT-ALIGN: left">David Tours & Travel</TD><TD style="TEXT-ALIGN: left">LMW/10-1317.75, MSF/11-483.5</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: left">David Tours & Travel</TD><TD style="TEXT-ALIGN: left">203896</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">LMK/10-322</TD><TD style="TEXT-ALIGN: left">322.00</TD><TD style="TEXT-ALIGN: left">K & A Auto Salvage Inc</TD><TD style="TEXT-ALIGN: left">PHM/10-2351.5</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: left">David Tours & Travel</TD><TD style="TEXT-ALIGN: left">203896</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">MSF/11-483.5</TD><TD style="TEXT-ALIGN: left">483.50</TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: left">K & A Auto Salvage Inc</TD><TD style="TEXT-ALIGN: left">229479</TD><TD style="TEXT-ALIGN: left; FONT-SIZE: 9pt">PHM/10-2351.5</TD><TD style="TEXT-ALIGN: left">2,351.50</TD><TD> </TD><TD> </TD></TR></TBODY></TABLE>
 
Upvote 0
Alex O,


It would appear that the data for David Tours & Travel in cell AL7 of your latest screenshot is not correct: LMW/10-1317.75, MSF/11-483.5



Sample raw data before the macro:


Excel Workbook
AFAHAIAJAKAL
4Original ListREFERENCE # *Values OnlyBook/Year-Account Write-off TotalLine Item Totals
5A-1 Asphalt Driveways120499VSB/09-2375.42,375.40
6Knotts Interiors Inc202609LMW/09-38.538.5
7Knotts Interiors Inc202609LMW/10-1317.751,317.75
8David Tours & Travel203896LMK/10-322322
9David Tours & Travel203896MSF/11-483.5483.5
10K & A Auto Salvage Inc229479PHM/10-2351.52,351.50
11
Sheet1





After the macro:


Excel Workbook
AFAHAIAJAKAL
4Original ListREFERENCE # *Values OnlyBook/Year-Account Write-off TotalLine Item Totals
5A-1 Asphalt Driveways120499VSB/09-2375.42,375.40A-1 Asphalt DrivewaysVSB/09-2375.4
6Knotts Interiors Inc202609LMW/09-38.538.5Knotts Interiors IncLMW/09-38.5, LMW/10-1317.75
7Knotts Interiors Inc202609LMW/10-1317.751,317.75David Tours & TravelLMK/10-322, MSF/11-483.5
8David Tours & Travel203896LMK/10-322322K & A Auto Salvage IncPHM/10-2351.5
9David Tours & Travel203896MSF/11-483.5483.5
10K & A Auto Salvage Inc229479PHM/10-2351.52,351.50
11
Sheet1





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code: 
Option Explicit
Sub ConcatDataV3()
' hiker95, 04/06/2011
' http://www.mrexcel.com/forum/showthread.php?t=541381
Dim LR As Long, LR2 As Long, a As Long, aa As Long, SR As Long, ER As Long, H As String
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "AF").End(xlUp).Row
Range("AK4:AN" & LR).ClearContents
Range("AF4:AF" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AK4"), Unique:=True
Range("AK4").ClearContents
LR2 = Cells(Rows.Count, "AK").End(xlUp).Row
Range("AM5").Formula = "=MATCH(AK5,AF:AF,0)"
Range("AM5").AutoFill Destination:=Range("AM5:AM" & LR2)
Range("AN5").Formula = "=AM6-1"
Range("AN5").AutoFill Destination:=Range("AN5:AN" & LR2 - 1)
Range("AN" & LR2) = LR
For a = 5 To LR2 Step 1
  SR = Range("AM" & a).Value
  ER = Range("AN" & a).Value
  H = ""
  For aa = SR To ER Step 1
    H = H & Cells(aa, "AI") & ", "
  Next aa
  If Right(H, 2) = ", " Then H = Left(H, Len(H) - 2)
  Range("AL" & a) = H
Next a
Range("AM5:AN" & LR2).ClearContents
Columns("AK:AL").AutoFit
Range("AK4").Select
Application.ScreenUpdating = True
End Sub


Then run the ConcatDataV3 macro.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
622
smozgur
smozgur
E
  • Question Question
VBA code clean up
Replies
9
Views
582
mumps
mumps
K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
224
krunal123
K
C
  • Question Question
Picture won't paste in cell overlay
Replies
0
Views
250
Cerka
C
D
  • Question Question
Looking for a way to allocate shifts between teams, maybe a LET formula
Replies
0
Views
89
Dazzybeeguy
D

Forum statistics

Threads
1,224,587
Messages
6,179,735
Members
452,939
Latest member
WCrawford

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