| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with a Macro?
Hi,
I have a spreadsheet were I have list of accounts and they are catergorized by location in the same column. For example Column B looks like this. P100161000 Cash P100262000 AR P100363000 AP P100464000 Fixed Assets P100565000 Inventory * J101 J101 P100161000 Cash P100262000 AR P100363000 AP P100565000 Inventory * M102 M102 So it will list the accounts and then the last item will be the location. What I want to do is have the location in column A right next to the account. Does anyone have a macro that can go down the list and put the location in front of the account? And then delete the row with the location. By the way I have a macro that will do it if one is alphanumeric and the other is not, but as you can see both cells are alphanumeric in this one. I will copy the code I have below. 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If IsNumeric(Cells(i, 2)) Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If Thanks Mascot |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with a Macro?
Mascot,
is this what you mean? you want for P100161000 Cash eg: col A | col b | Cash | P100161000 | |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with a Macro?
Hi Stevebriz,
This is what I mean. ColumnA | ColumnB * J101 J101 | P100565000 Inventory "stevebriz" wrote: Mascot, is this what you mean? you want for P100161000 Cash eg: col A | col b | Cash | P100161000 | |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with a Macro?
Assume the asterisk is not actually there and that was for emphasis only.
Assume you are actually displaying column B and C and the location is less than 9 characters long. Further assume that accounts will be at least 9 characters long 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If len(trim(Cells(i, 2))) 8 Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If -- Regards, Tom Ogilvy "Mascot" wrote: Hi, I have a spreadsheet were I have list of accounts and they are catergorized by location in the same column. For example Column B looks like this. P100161000 Cash P100262000 AR P100363000 AP P100464000 Fixed Assets P100565000 Inventory * J101 J101 P100161000 Cash P100262000 AR P100363000 AP P100565000 Inventory * M102 M102 So it will list the accounts and then the last item will be the location. What I want to do is have the location in column A right next to the account. Does anyone have a macro that can go down the list and put the location in front of the account? And then delete the row with the location. By the way I have a macro that will do it if one is alphanumeric and the other is not, but as you can see both cells are alphanumeric in this one. I will copy the code I have below. 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If IsNumeric(Cells(i, 2)) Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If Thanks Mascot |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with a Macro?
Hi Tom,
Thanks for replying. The asterisk is there. For some reason the sytem we use has it. However after I run the macro I am going to do a "Text To Columns" and change the location from this * J101 J101 to J101, so I will be getting rid of the asterik and have the location once instead of twice. I hope that helps. Mascot "Tom Ogilvy" wrote: Assume the asterisk is not actually there and that was for emphasis only. Assume you are actually displaying column B and C and the location is less than 9 characters long. Further assume that accounts will be at least 9 characters long 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If len(trim(Cells(i, 2))) 8 Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If -- Regards, Tom Ogilvy "Mascot" wrote: Hi, I have a spreadsheet were I have list of accounts and they are catergorized by location in the same column. For example Column B looks like this. P100161000 Cash P100262000 AR P100363000 AP P100464000 Fixed Assets P100565000 Inventory * J101 J101 P100161000 Cash P100262000 AR P100363000 AP P100565000 Inventory * M102 M102 So it will list the accounts and then the last item will be the location. What I want to do is have the location in column A right next to the account. Does anyone have a macro that can go down the list and put the location in front of the account? And then delete the row with the location. By the way I have a macro that will do it if one is alphanumeric and the other is not, but as you can see both cells are alphanumeric in this one. I will copy the code I have below. 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If IsNumeric(Cells(i, 2)) Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If Thanks Mascot |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with a Macro?
So just change the condition to check for:
'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If Left(trim(Cells(i, 2)),1) < "*" Then Cells(i, 1) = loc Else loc = Trim(Cells(i, 2)) ' optional ' loc = right(loc,len(loc)-1) ' iloc = Instr(1,loc," ",vbTextcompare) ' loc = Left(loc,iloc-1) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If -- Regards, Tom Ogilvy "Mascot" wrote: Hi Tom, Thanks for replying. The asterisk is there. For some reason the sytem we use has it. However after I run the macro I am going to do a "Text To Columns" and change the location from this * J101 J101 to J101, so I will be getting rid of the asterik and have the location once instead of twice. I hope that helps. Mascot "Tom Ogilvy" wrote: Assume the asterisk is not actually there and that was for emphasis only. Assume you are actually displaying column B and C and the location is less than 9 characters long. Further assume that accounts will be at least 9 characters long 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If len(trim(Cells(i, 2))) 8 Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If -- Regards, Tom Ogilvy "Mascot" wrote: Hi, I have a spreadsheet were I have list of accounts and they are catergorized by location in the same column. For example Column B looks like this. P100161000 Cash P100262000 AR P100363000 AP P100464000 Fixed Assets P100565000 Inventory * J101 J101 P100161000 Cash P100262000 AR P100363000 AP P100565000 Inventory * M102 M102 So it will list the accounts and then the last item will be the location. What I want to do is have the location in column A right next to the account. Does anyone have a macro that can go down the list and put the location in front of the account? And then delete the row with the location. By the way I have a macro that will do it if one is alphanumeric and the other is not, but as you can see both cells are alphanumeric in this one. I will copy the code I have below. 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If IsNumeric(Cells(i, 2)) Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If Thanks Mascot |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with a Macro?
Hi Tom,
This works great. Except when I include the optional code it ends up just deleting the whole sheet. Do you know what could be causing this? Mascot "Tom Ogilvy" wrote: So just change the condition to check for: 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If Left(trim(Cells(i, 2)),1) < "*" Then Cells(i, 1) = loc Else loc = Trim(Cells(i, 2)) ' optional ' loc = right(loc,len(loc)-1) ' iloc = Instr(1,loc," ",vbTextcompare) ' loc = Left(loc,iloc-1) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If -- Regards, Tom Ogilvy "Mascot" wrote: Hi Tom, Thanks for replying. The asterisk is there. For some reason the sytem we use has it. However after I run the macro I am going to do a "Text To Columns" and change the location from this * J101 J101 to J101, so I will be getting rid of the asterik and have the location once instead of twice. I hope that helps. Mascot "Tom Ogilvy" wrote: Assume the asterisk is not actually there and that was for emphasis only. Assume you are actually displaying column B and C and the location is less than 9 characters long. Further assume that accounts will be at least 9 characters long 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If len(trim(Cells(i, 2))) 8 Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If -- Regards, Tom Ogilvy "Mascot" wrote: Hi, I have a spreadsheet were I have list of accounts and they are catergorized by location in the same column. For example Column B looks like this. P100161000 Cash P100262000 AR P100363000 AP P100464000 Fixed Assets P100565000 Inventory * J101 J101 P100161000 Cash P100262000 AR P100363000 AP P100565000 Inventory * M102 M102 So it will list the accounts and then the last item will be the location. What I want to do is have the location in column A right next to the account. Does anyone have a macro that can go down the list and put the location in front of the account? And then delete the row with the location. By the way I have a macro that will do it if one is alphanumeric and the other is not, but as you can see both cells are alphanumeric in this one. I will copy the code I have below. 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If IsNumeric(Cells(i, 2)) Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If Thanks Mascot |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with a Macro?
because I didn't notice there was a space after the asterisk and account for
it. Sub AAA() 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If Left(Trim(Cells(i, 2)), 1) < "*" Then Cells(i, 1) = loc Else loc = Trim(Cells(i, 2)) Debug.Print loc ' optional loc = Right(loc, Len(loc) - 2) iloc = InStr(1, loc, " ", vbTextCompare) loc = Left(loc, iloc - 1) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If End Sub worked for me with the data you show. -- Regards, Tom Ogilvy "Mascot" wrote: Hi Tom, This works great. Except when I include the optional code it ends up just deleting the whole sheet. Do you know what could be causing this? Mascot "Tom Ogilvy" wrote: So just change the condition to check for: 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If Left(trim(Cells(i, 2)),1) < "*" Then Cells(i, 1) = loc Else loc = Trim(Cells(i, 2)) ' optional ' loc = right(loc,len(loc)-1) ' iloc = Instr(1,loc," ",vbTextcompare) ' loc = Left(loc,iloc-1) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If -- Regards, Tom Ogilvy "Mascot" wrote: Hi Tom, Thanks for replying. The asterisk is there. For some reason the sytem we use has it. However after I run the macro I am going to do a "Text To Columns" and change the location from this * J101 J101 to J101, so I will be getting rid of the asterik and have the location once instead of twice. I hope that helps. Mascot "Tom Ogilvy" wrote: Assume the asterisk is not actually there and that was for emphasis only. Assume you are actually displaying column B and C and the location is less than 9 characters long. Further assume that accounts will be at least 9 characters long 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If len(trim(Cells(i, 2))) 8 Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If -- Regards, Tom Ogilvy "Mascot" wrote: Hi, I have a spreadsheet were I have list of accounts and they are catergorized by location in the same column. For example Column B looks like this. P100161000 Cash P100262000 AR P100363000 AP P100464000 Fixed Assets P100565000 Inventory * J101 J101 P100161000 Cash P100262000 AR P100363000 AP P100565000 Inventory * M102 M102 So it will list the accounts and then the last item will be the location. What I want to do is have the location in column A right next to the account. Does anyone have a macro that can go down the list and put the location in front of the account? And then delete the row with the location. By the way I have a macro that will do it if one is alphanumeric and the other is not, but as you can see both cells are alphanumeric in this one. I will copy the code I have below. 'Add Data Dim lastrow As Long Dim i As Long, loc As String Columns(1).ClearContents lastrow = Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 If IsNumeric(Cells(i, 2)) Then Cells(i, 1) = loc Else loc = Cells(i, 2) End If Next Dim rng As Range On Error Resume Next Set rng = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End If Thanks Mascot |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Macro recorded... tabs & file names changed, macro hangs | Excel Worksheet Functions | |||
| Macro Help Needed - Excel 2007 - Print Macro with Auto Sort | Excel Worksheet Functions | |||
| Need syntax for RUNning a Word macro with an argument, called from an Excel macro | Excel Programming | |||
| how to count/sum by function/macro to get the number of record to do copy/paste in macro | Excel Programming | |||
| Start Macro / Stop Macro / Restart Macro | Excel Programming | |||
Hybrid Mode
