Formula or VBA to retrive information

Wimpie

Board Regular
Joined
Aug 12, 2008
Messages
210
Good day

Please assist
I have in column A the following:
A4 = Total Cost centre LONMIN
with a lot of other information below it in the other Rows, e.g. Total income, Deductions, etc.
Still in Column A I will have Total Company Cost with a total in Column c in the same line, e.g
A22 = Total Company Cost and C22 = 71703,
Then in Column A the following with no lone break
A23 - Total Cost Centre Polokwane
With the same as the above, the number of lines in between each cost centre differ
I need to remove the Total Cost Centre before the name of each (as in line A4 and A23) and then place the name only in Column B, I think this is a LEFT or Right formula.
Then I need to move the total for each centre to Column C next to the name i hope this makes sense
What it looks like now:
Total Cost Centre LONMIN
Income20
300110
300210
Deductions5
10042
10013
Total company cost18
Total Cost Centre POLOKWANE
Income40
300110
300210
300510
300610
Deductions10
10031
10022
10013
10044
Total Company Cost30
Total Cost Centre BRICKLAYERS

<TBODY>
</TBODY>
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
What I need it to look like:
Total Cost Centre LONMINLONMIN18
Income20
300110
300210
Deductions5
10042
10013
Total company cost18
Total Cost Centre POLOKWANEPOLOKWANE30
Income40
300110
300210
300510
300610
Deductions10
10031
10022
10013
10044
Total Company Cost30
Total Cost Centre BRICKLAYERS

<TBODY>
</TBODY>
 
Upvote 0
Try this:-
Code:
[COLOR=Navy]Sub[/COLOR] MG04Jan37
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Tem1 [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Tem2 [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] UCase(Dn) Like "TOTAL COST CENTRE *" [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] Tem1 = Dn
        [COLOR=Navy]If[/COLOR] UCase(Dn) Like "TOTAL COMPANY COST" [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] Tem2 = Dn
            [COLOR=Navy]If[/COLOR] Not Tem1 [COLOR=Navy]Is[/COLOR] Nothing And Not Tem2 [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
                Tem1.Offset(, 1) = Right(Tem1, Len(Tem1) - 18)
                Tem1.Offset(, 2) = Tem2.Offset(, 2)
                [COLOR=Navy]Set[/COLOR] Tem1 = Nothing
                [COLOR=Navy]Set[/COLOR] Tem2 = Nothing
            [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
Mick,
Pasted it into the modile and I ran it, does not seem to do anything,
Looks like what i need but not doing anything
 
Upvote 0
Here is a different macro that you can try...

Code:
Sub CopyNameAndTotalToBlanks()
  Dim X As Long, CostCentres As Range, CompanyCosts As Range
  Application.ScreenUpdating = False
  Columns("A").Replace "Total Cost Centre", "=Total Cost Centre", xlPart, , False
  Set CostCentres = Columns("A").SpecialCells(xlFormulas, xlErrors)
  Columns("A").Replace "=", "", xlPart
  Columns("A").Replace "Total Company Cost", "=Total Company Cost", xlPart, , False
  Set CompanyCosts = Columns("A").SpecialCells(xlFormulas, xlErrors)
  Columns("A").Replace "=", "", xlPart
  For X = 1 To CompanyCosts.Areas.Count
    CostCentres.Areas(X).Offset(, 1).Value = Mid(CostCentres.Areas(X).Value, 19)
    CostCentres.Areas(X).Offset(, 2).Value = CompanyCosts.Areas(X).Offset(, 2).Value
    CostCentres.Areas(X).Offset(, 1).Resize(, 2).Font.Bold = True
    CostCentres.Areas(X).Offset(, 1).Resize(, 2).Font.ColorIndex = 5
  Next
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Good day Rick

It comes up with an error 1004
No cells were found
Debug shows problem to be the below
Set CostCentres = Columns("A").SpecialCells(xlFormulas, xlErrors)
 
Last edited:
Upvote 0
Good day Rick

It comes up with an error 1004
No cells were found
Debug shows problem to be the below
Set CostCentres = Columns("A").SpecialCells(xlFormulas, xlErrors)
Three questions...

1) Is the first column you show you data in Column A?

2) Does the cells you show "Total Cost Centre {name}" start with the "T" or is there a blank space in front of it?

3) Is the beginning of each cost centre cell exactly "Total Cost Centre"?
 
Upvote 0
Good day Rick

Sorry about this
1) yes it is the 1st column
2) It should have been "Totals Cost Centre {name} with no blank spaces. I have changed the VBA to reflect Totals and not Total
3) Yes, they all start with Totals Cost Centre

After change was made to "Totals Cost Centre" it added the "=" and,
gave me another 1004
no cells were found
debug moved to
Set CostCentres = Columns("A").SpecialCells(xlFormulas, xlErrors)
 
Upvote 0
Good day Rick

Sorry about this
1) yes it is the 1st column
2) It should have been "Totals Cost Centre {name} with no blank spaces. I have changed the VBA to reflect Totals and not Total
3) Yes, they all start with Totals Cost Centre

After change was made to "Totals Cost Centre" it added the "=" and,
gave me another 1004
no cells were found
debug moved to
Set CostCentres = Columns("A").SpecialCells(xlFormulas, xlErrors)

Pretty much the same questions as before, but now for the cells containing "Total Company Cost"

Also, you say it put the = sign in front of some (all?) the "Total Company Cost" cells? Did those cells then display a #NAME! error?
 
Upvote 0

Forum statistics

Threads
1,214,659
Messages
6,120,786
Members
448,992
Latest member
prabhuk279

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