-
1 Attachment(s)
Code to insert fields onto existing worksheet
Hi...I need some help with vba code please. We get a worksheet each month where columns A to E are populated but the number of rows will vary each month. What I want to do is to run a code which will add another 5 fields (columns G to K - column J is a formula) with the colur formatting in each column.
As the number of rows will vary I need the correct number of rows to be added to the inserted columns. On the last row I also need to have a total for each column. The user will manually populate the added columns. I'm attaching a sample to make it easier to understand what I'm after.
Any help would be appreciated. Thanks
-
Re: Code to insert fields onto existing worksheet
Try something like this:
Code:
Sub addCols()
Dim ws As Worksheet
Dim j As Long
Dim lr As Long
Set ws = ActiveSheet
lr = ws.Range("a4").End(xlDown).Row 'in your example, row 15
With ws
.Range("g1").Value = "Forecast"
.Range("g1:j1").MergeCells = True
.Range("g1:j1").HorizontalAlignment = xlCenterAcrossSelection
.Range("g1").Font.Bold = True
.Range("g1").Font.Italic = True
.Range("g2").Value = "Best"
.Range("h2").Value = "Likely"
.Range("i2").Value = "Worst"
.Range("j2").Value = "Spread"
.Range("g2:j2").Font.Bold = True
.Range("g2:j2").Font.Italic = True
.Range("g2:g" & lr).Interior.Color = 12379352
.Range("h2:h" & lr).Interior.Color = 15986394
.Range("i2:i" & lr).Interior.Color = 14281213
.Range("j5").Formula = "=g5-i5"
.Range("j5").Copy
.Range("j6:j" & lr).PasteSpecial
Application.CutCopyMode = False
.Range("b" & lr + 2).FormulaR1C1 = "=SUM(R[" & 5 - (lr + 2) & "]C:R[-2]C)"
.Range("b" & lr + 2).Copy
.Range("c" & lr + 2 & ":e" & lr + 2).PasteSpecial
.Range("g" & lr + 2 & ":j" & lr + 2).PasteSpecial
Application.CutCopyMode = False
.Range("a" & lr).Value = "Total"
.Range("k1").Value = "Comments"
.Range("k1").Font.Bold = True
.Range("k1").Font.Italic = True
.Range("k1").ColumnWidth = 20
.Range("k1").HorizontalAlignment = xlCenter
.Range("k1:k2").Merge
.Range("g5").Select
End With
Set ws = Nothing
End Sub
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
Hi...thanks so much for the code. It works nicely except for some reason it is adding the word TOTAL in the last row in column A above the other TOTAL. Please see attached file.
Also is it possible to format the new columns so that the text is the same as columns A to E and there is a border as per the original sample? Thanks so much.
-
Re: Code to insert fields onto existing worksheet
When you first get the spreadsheet with A-E populated, is the total row present, or no?
-
Re: Code to insert fields onto existing worksheet
Quote:
Originally Posted by
vbfbryce
When you first get the spreadsheet with A-E populated, is the total row present, or no?
It is not pouplated at the moment I added it manually but I can get the spreadsheet changed to include the total to columns A-E if it is easier?
-
Re: Code to insert fields onto existing worksheet
No, not necessary to have them populated. Probably easier without. Back in a few with update.
-
Re: Code to insert fields onto existing worksheet
Code:
Sub addCols()
Dim ws As Worksheet
Dim j As Long
Dim lr As Long
Set ws = ActiveSheet
lr = ws.Range("a4").End(xlDown).Row 'in your example, row 15
With ws
.Range("b1").Copy
.Range("g1").PasteSpecial
.Range("g2:j2").PasteSpecial
.Application.CutCopyMode = False
.Range("g1").Select
.Range("g1").Value = "Forecast"
.Range("g1:j1").MergeCells = True
.Range("g1:j1").HorizontalAlignment = xlCenterAcrossSelection
.Range("g2").Value = "Best"
.Range("h2").Value = "Likely"
.Range("i2").Value = "Worst"
.Range("j2").Value = "Spread"
.Range("b5:b" & lr).Copy
.Range("g5").PasteSpecial xlPasteFormats
.Range("h5").PasteSpecial xlPasteFormats
.Range("i5").PasteSpecial xlPasteFormats
.Range("j5").PasteSpecial xlPasteFormats
.Range("g2:g" & lr).Interior.Color = 12379352
.Range("h2:h" & lr).Interior.Color = 15986394
.Range("i2:i" & lr).Interior.Color = 14281213
.Range("j5").Formula = "=g5-i5"
.Range("j5").Copy
.Range("j6:j" & lr).PasteSpecial
Application.CutCopyMode = False
.Range("b" & lr + 2).FormulaR1C1 = "=SUM(R[" & 5 - (lr + 2) & "]C:R[-2]C)"
.Range("b" & lr + 2).Copy
.Range("c" & lr + 2 & ":e" & lr + 2).PasteSpecial
.Range("g" & lr + 2 & ":j" & lr + 2).PasteSpecial
Application.CutCopyMode = False
.Range("a" & lr + 2).Value = "Total" 'changed this to "lr +2"
.Range("k1").Value = "Comments"
.Range("k1").Font.Bold = True
.Range("k1").Font.Italic = True
.Range("k1").ColumnWidth = 20
.Range("k1").HorizontalAlignment = xlCenter
.Range("k1:k2").Merge
.Range("g5").Select
.Range("g1:j1").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
.Range("g2:i2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
.Range("j2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
.Range("k1:k2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
With .Range("g3:g" & lr).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
With .Range("i3:i" & lr).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
With .Range("j3:j" & lr).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
With .Range("k3:k" & lr).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
End With
Set ws = Nothing
End Sub
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
Hi...that code works beautifully. Thanks so much. I have an added complication now. I have now been told that there will be 4 worksheets on the workbook with the same format so I need to apply the code to all 4 sheets. I also need to add a "Summary" sheet at the beginning to bring through the totals from the 4 sheets. I'm attaching a sample file. Can the code be easily modified to pick this up? Thanks again.
-
Re: Code to insert fields onto existing worksheet
Yeah, we can do that. I probably won't get back to it til tomorrow.
-
Re: Code to insert fields onto existing worksheet
Quote:
Originally Posted by
vbfbryce
Yeah, we can do that. I probably won't get back to it til tomorrow.
OK thanks but if you get a chance to look at it today that would really help me please. :)
-
Re: Code to insert fields onto existing worksheet
Updated to loop through all sheets with names starting with "Dept" and then add Summary sheet (note that you'll have to do some formatting of the summary sheet similar to what I did for the totals in the Dept sheets):
Code:
Sub addCols()
Dim wb As Workbook '*********************************************8
Dim ws As Worksheet
Dim h As Integer
Dim j As Long
Dim lr As Long
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
For h = 1 To wb.Worksheets.Count
If Left(wb.Worksheets(h).Name, 3) = "Sum" Then
Application.DisplayAlerts = False
wb.Worksheets(h).Delete
Exit Sub
End If
Next h
For h = 1 To wb.Worksheets.Count
If Left(wb.Worksheets(h).Name, 4) = "Dept" Then
Set ws = wb.Worksheets(h)
ws.Select
lr = ws.Range("a4").End(xlDown).Row 'in your example, row 15
With ws
.Range("b1").Copy
.Range("g1").PasteSpecial
.Range("g2:j2").PasteSpecial
.Application.CutCopyMode = False
.Range("g1").Select
.Range("g1").Value = "Forecast"
.Range("g1:j1").MergeCells = True
.Range("g1:j1").HorizontalAlignment = xlCenterAcrossSelection
.Range("g2").Value = "Best"
.Range("h2").Value = "Likely"
.Range("i2").Value = "Worst"
.Range("j2").Value = "Spread"
.Range("b5:b" & lr).Copy
.Range("g5").PasteSpecial xlPasteFormats
.Range("h5").PasteSpecial xlPasteFormats
.Range("i5").PasteSpecial xlPasteFormats
.Range("j5").PasteSpecial xlPasteFormats
.Range("g2:g" & lr).Interior.Color = 12379352
.Range("h2:h" & lr).Interior.Color = 15986394
.Range("i2:i" & lr).Interior.Color = 14281213
.Range("j5").Formula = "=g5-i5"
.Range("j5").Copy
.Range("j6:j" & lr).PasteSpecial
Application.CutCopyMode = False
.Range("b" & lr + 2).FormulaR1C1 = "=SUM(R[" & 5 - (lr + 2) & "]C:R[-2]C)"
.Range("b" & lr + 2).Copy
.Range("c" & lr + 2 & ":e" & lr + 2).PasteSpecial
.Range("g" & lr + 2 & ":j" & lr + 2).PasteSpecial
Application.CutCopyMode = False
.Range("a" & lr + 2).Value = "Total" 'changed this to "lr +2"
.Range("k1").Value = "Comments"
.Range("k1").Font.Bold = True
.Range("k1").Font.Italic = True
.Range("k1").ColumnWidth = 20
.Range("k1").HorizontalAlignment = xlCenter
.Range("k1:k2").Merge
.Range("g5").Select
.Range("g1:j1").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
.Range("g2:i2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
.Range("j2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
.Range("k1:k2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
With .Range("g3:g" & lr).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
With .Range("i3:i" & lr).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
With .Range("j3:j" & lr).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
With .Range("k3:k" & lr).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
End With
Set ws = Nothing
End If
Next h
'create summary
wb.Sheets.Add before:=wb.Worksheets(1)
wb.Worksheets(1).Name = "Summary"
Set ws = wb.Worksheets("Summary")
With ws
.Range("a3").Value = "Department"
.Range("b3").Value = "Amount1"
.Range("c3").Value = "Amount2"
.Range("d3").Value = "Amount3"
.Range("e3").Value = "Total"
.Range("g3").Value = "Forecast"
'best, likely, etc...
For h = 2 To wb.Worksheets.Count
If Left(wb.Worksheets(h).Name, 4) = "Dept" Then
ws.Range("a" & 4 + h).Value = wb.Worksheets(h).Name
lr = wb.Worksheets(h).Range("a" & Rows.Count).End(xlUp).Row
For j = 2 To 5
ws.Cells(4 + h, j) = wb.Worksheets(h).Cells(lr, j)
Next j
For j = 7 To 10
'ws.Cells(4 + h, j) = wb.Worksheets(h).Cells(lr, j)
'ActiveCell.FormulaR1C1 = "=Dept1!R[11]C"
ws.Cells(4 + h, j).FormulaR1C1 = "=" & wb.Worksheets(h).Name & "!R[" _
& lr - (4 + h) & "]C"
Next j
End If
Next h
End With
Set wb = Nothing
Application.ScreenUpdating = True
End Sub
-
Re: Code to insert fields onto existing worksheet
Thanks so much for this. I'll copy the formatting from the first part of the code. This code will work fine for all sheets starting with "Dept" but I may also get files in exactly the same format but each sheet might have a completely different name and won't start with "Dept". For example, sheet 1 might be named "New York", sheet 2 "LA", sheet 3 "Washington" etc. Can this code handle this? I'm sorry to be a pain. Thanks again.
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
Hi...I've edited the code for the formatting and it works fine. I would like to format the numbers so they are all comma separated in all columns (1,000) and also have a total on the summary sheet like on the other sheets. Also on the Summary sheet the colour formatting is copying down to row 15 rather than just 4 rows. I'm attaching the file. Thanks again.
-
Re: Code to insert fields onto existing worksheet
Quote:
Originally Posted by
fusion001
Thanks so much for this. I'll copy the formatting from the first part of the code. This code will work fine for all sheets starting with "Dept" but I may also get files in exactly the same format but each sheet might have a completely different name and won't start with "Dept". For example, sheet 1 might be named "New York", sheet 2 "LA", sheet 3 "Washington" etc. Can this code handle this? I'm sorry to be a pain. Thanks again.
Hi just a quick update on this. I said each worksheet can have a different name but I've seen that they all start with Output1 (LA), Output1 (NY), Output1(WA), etc. So maybe this makes it easier. But what I would like to have is on the Summary sheet just to list the names as LA, NY, WA on each row without the word Output1 in front. Thanks.
-
Re: Code to insert fields onto existing worksheet
Assuming your sheet names always end in (xx) where "xx" is a two character state abbreviation, look for this spot and make these changes:
Code:
Dim tmpName As String '*** add this
For h = 2 To wb.Worksheets.Count
'If Left(wb.Worksheets(h).Name, 4) = "Dept" Then
If Left(wb.Worksheets(h).Name, 4) = "Outp" Then 'changed ***
'ws.Range("a" & 4+h).Value=mid(wb.Worksheets(h).name)
tmpName = wb.Worksheets(h).Name 'added ***
tmpName = Right(tmpName, 3) 'added ***
tmpName = Left(tmpName, 2) 'added ***
'ws.Range("a" & 4 + h).Value = wb.Worksheets(h).Name
ws.Range("a" & 4 + h).Value = tmpName 'changed ***
lr = wb.Worksheets(h).Range("a" & Rows.Count).End(xlUp).Row
For j = 2 To 5
Toward the very end, this would have to change to handle the spaces and "()" in the sheet names:
Code:
ws.Cells(4 + h, j).FormulaR1C1 = "='" & wb.Worksheets(h).Name & "'!R[" _
& lr - (4 + h) & "]C"
Not sure at this point which of the other issues (formatting maybe?) you're still having...
-
Re: Code to insert fields onto existing worksheet
Thanks for that. If the names are longer than two characters where do I need to change the code? Thanks so much for your help with this. I really appreciate it.
-
Re: Code to insert fields onto existing worksheet
You're saying that within the parentheses there may be more than two characters, yeah?
-
Re: Code to insert fields onto existing worksheet
Yeah. Some sheets could have a name like Output1(LA), output1(WARR) etc. Thanks.
-
Re: Code to insert fields onto existing worksheet
updated:
Code:
Dim tmpName As String '*** add this
Dim leftP As Integer 'position of "("
Dim rightP As Integer 'position of ")"
For h = 2 To wb.Worksheets.Count
'If Left(wb.Worksheets(h).Name, 4) = "Dept" Then
If Left(wb.Worksheets(h).Name, 4) = "Outp" Then 'changed ***
'ws.Range("a" & 4+h).Value=mid(wb.Worksheets(h).name)
tmpName = wb.Worksheets(h).Name 'added ***
leftP = InStr(1, tmpName, "(")
If leftP > 0 Then
rightP = InStr(leftP, tmpName, ")")
If rightP > 0 Then
tmpName = Mid(tmpName, leftP + 1, (rightP - leftP - 1))
Else
MsgBox "Worksheet name does not have ) in it"
Exit Sub
End If
Else
MsgBox "Worksheet name does not have ( in it"
Exit Sub
End If
'tmpName = Right(tmpName, 3) 'added ***
'tmpName = Left(tmpName, 2) 'added ***
'ws.Range("a" & 4 + h).Value = wb.Worksheets(h).Name
ws.Range("a" & 4 + h).Value = tmpName 'changed ***
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
Thanks so much for the code. I will update it and try it. I have now been told that we could have this report in a different format as well where it is split by Expenditure and Income on each worksheet. So one part will have the expenditure figures and the totals then and the bottom part for the income figures and totals and then a grand total. The number of rows could vary between each part and worksheets. A summary sheet is also required as in the original scenario.
I am attaching a sample to explain what I need to do. Please note that I have not formatted the boxes etc. on the file which I will need to do for a neat presentation.
I will use the code you have provided for the original format of the worksheets but can this code be tweaked for this new scenario? Thanks again
-
Re: Code to insert fields onto existing worksheet
It can certainly be tweaked for the new scenario; I'd like to see you attempt it first, and ask for help if you don't succeed.
-
Re: Code to insert fields onto existing worksheet
Quote:
Originally Posted by
vbfbryce
It can certainly be tweaked for the new scenario; I'd like to see you attempt it first, and ask for help if you don't succeed.
LOL now you're asking! I wish I was a quarter as good as you.
I've been told that the format of the report might change in terms of Expendiure and Income shown along the columns so the department codes are only shown once and the figures in the apporpriate columns. So the Best, Likely, Worst columns need to be added to each section after Expenditure and Income.
If I do the template can you please check if it will still be case of tweaking the existing code? Thanks
-
Re: Code to insert fields onto existing worksheet
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
Quote:
Originally Posted by
vbfbryce
sure thing
Please find attached sample to give you an idea. The formatting (borders, etc) is not exact and also I will need a summary sheet as previous examples. The coloured columns will be manually completed. Thanks
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
So is the top part of the attached image how the "before" will look, and the bottom part the "after?"
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
Hi I want to end up with the "After" but the start will be like this
Attachment 118187
The expenditure figures will be above the Income figures. The Departments should only be listed once where they are both in the Expenditure and Income. I hope this makes sense. Thanks
-
Re: Code to insert fields onto existing worksheet
Please zip/attach the before and after; an image is hard to see, and it appears the number of columns (Amount 1, 2, etc.) has changed, so before I go any further I want to be sure I have the most current requirements. Thanks.
-
Re: Code to insert fields onto existing worksheet
OK I will show all the columns needed. Thanks again
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
Please find attached example. The first sheet in an example of the original data format (BEFORE) and the second sheet (AFTER) of how the new format of the data should be. Don't need to keep the original format so it can be overwritten with the new format on the same sheet. As mentioned in earlier posts there will be multiple sheets so the code will need to loop through all the sheets. I hope this helps. Thanks again.
-
Re: Code to insert fields onto existing worksheet
Hi vbfbryce did you get a chance to check the example to see if this is something that can be done? Thanks
-
Re: Code to insert fields onto existing worksheet
it can definitely be done, but i won't have the time to do it. each change in reqs takes a fair amount of time to sort through, especially when things like "where the first column of data is" are changed. i think you should be able to use the examples i've given and try to modify to fit your latest changed requirements, but i can't give you the complete solution again.
give it a shot, let us know where you stumble.
-
Re: Code to insert fields onto existing worksheet
I will try to do it. Are you able to help me with the code for splitting the report into the three sections as in the example so I have all the codes listed in the rows and then the three splits across the columns to start me off please?
-
Re: Code to insert fields onto existing worksheet
Will detail the steps, but not the code:
1) Find the beginning and the end of the top section (can't remember if it's income or expenditures).
2) Add the columns to the right of that region (like we've already done).
3) Find the beginning and the end of the bottom section.
4) Copy that region to the next available columns.
5) Add the other columns to the right of it.
There are examples in the "current code" that should show the general idea for each step.
-
Re: Code to insert fields onto existing worksheet
Thanks again. That's the bit I'm not sure about the code I need to find the top and end of the top section, the start of the middle and end of middle etc. The top part will say Expenditure 1 and the start of the middle part will say Expenditure 2 and the start of the bottom part will say Income but I'm not sure how to code this. You have already helped me a lot and would really appreciate your help on this part. Thanks
-
Re: Code to insert fields onto existing worksheet
Use some sample data blocks, one starting in A4, the other starting a couple rows below the bottom of the first block, and step through this, watching the values of the variables as you do:
Code:
Sub findStartEnd()
Dim ws As Worksheet
Dim startTop As Integer
Dim endTop As Integer
Dim startBottom As Integer
Dim endBottom As Integer
Set ws = ActiveSheet
stop
startTop = 4 'if the first row of data will ALWAYS be row 4
endrow = ws.Range("a" & startTop).End(xlDown).Row 'this is the equivalent of having cell A4 selected, then hitting CTRL+Down (the down arrow)
'that takes you to the last filled cell in that column
MsgBox "Start row is: " & startTop & ", End row is: " & endTop
'then do the same thing for the "bottom section," figuring out where to start (ie. 2 rows below the word "Income" or something like that)
Set ws = Nothing
End Sub
-
Re: Code to insert fields onto existing worksheet
Thanks for the code. I tried it and I get compile error variable not defined on
Code:
endrow = ws.Range("a" & startTop).End(xlDown).Row
-
1 Attachment(s)
Re: Code to insert fields onto existing worksheet
I'm attaching the sheet with the code. Thanks
-
Re: Code to insert fields onto existing worksheet
Gave you a bad line, should have been "endTop=..." not "endrow=..."
Look at the variables which are dimmed at the beginning and compare to the offending line when that happens.
-
Re: Code to insert fields onto existing worksheet
Thanks. Sorry I need to pay more attention to the code.
Each time the length of the reports will vary so how will that affect the code?
-
Re: Code to insert fields onto existing worksheet
The intent of that kind of code is specifically to be able to handle ranges of varying size. Test it out manually by creating 2 or 3 different sized ranges, then starting in the upper left corner of each in turn, and hitting CTRL+Down.
