I'm making a macro that inserts a row on one sheet and then inserts this row in all the sheets but the separate columns should refer to the value of the general sheet.
E.g.:
I have 3 sheets and a template sheet.
Then I want to run a macro that inserts a row in the template sheet with some values.
And loops through all 3 sheets inserts the row in the same spot, and then comes the difficult part, it gives an active link to the template sheet cells.
So that when somebody changes the value of one of the cells on the template this value gets changed on all the different tabs.
I have this but this is not an active link it only sets the status of the value from that time and I can't find the syntax to make it an active reference.
For Each Current In Worksheets
Current.Cells(startCell.Row, startCell.Column).Offset(1).EntireRow.Insert
Current.Cells(rowNumber + 1, 1).Value = ws.Cells(rowNumber + 1, 1).Value
Current.Cells(rowNumber + 1, 2).Value = ws.Cells(rowNumber + 1, 2).Value
Current.Cells(rowNumber + 1, 2).Borders.LineStyle = xlContinuous
Current.Cells(rowNumber + 1, 3).Value = ws.Cells(rowNumber + 1, 3).Value
Current.Cells(rowNumber + 1, 3).Borders.LineStyle = xlContinuous
Current.Cells(rowNumber + 1, 4).Value = ws.Cells(rowNumber + 1, 4).Value
Current.Cells(rowNumber + 1, 4).Borders.LineStyle = xlContinuous
Current.Cells(rowNumber + 1, 5).Value = ws.Cells(rowNumber + 1, 5).Value
Current.Cells(rowNumber + 1, 5).Borders.LineStyle = xlContinuous
Next Current
The thing I was looking for was this:
'First get the address you need from that cell
testString = Range(Cells(2, 2), Cells(2, 2)).Address
'Add the = in front of the address
ActiveSheet.Cells(1, 1) = "=" & testString
But I had trouble wording what I needed and the solution I've provided works but is not nice coded.
If somebody has a better solution please be so kind...
Related
I have two tables, each one on different sheets. The first table is the one to be filled. It contains 4 columns, the first column contains code ie: "10007", "10009", the second column has the type of product ie: "H10", "H12", etc, and each type of product uses a type of flour, the third column has the demand of such products and the last column has the consumption, which is the one I am trying to obtained.
The second table indicates which values on the demand column can be sum to obtained the consumption of each product.
Example:
Table 1:
Week 1 CODE Flour Consumption Product Demand
1007 GF H102 152
1008 Regular H104 450
H105 256
Table 2
Product Code Flour
H102 1007 GF
H104 1007 GF
H105 1008 Regular
So for example, if i am looking for the consumption of 1007 from table 1 then I have to sum the demand if the product matches on the second table. So basically on the second table you find like a guide that it tells you product x is form by code x and flour x, so when you go to the first week you base the consumption on how it matches to the guide. Therefore, the first consumption should be 152+450 since H102 and H104 have the same code, and the second consumption should be just 256.
I was using range to see if the code will try to match the value on table 1 to table 2.
Dim i As Integer
For i = 14 To 76
If Cells(i, 23).Value = Worksheets("Products").Cells(15, 8).Value And Cells(i, 29).Value = Worksheets("Products").Range("B15:B36").Value And Cells(i + 1, 29).Value <> Worksheets("Products").Range("B15:B36").Value And Cells(i + 2, 29).Value <> Worksheets("Products").Range("B15:B36").Value Then
Cells(i, 25).Value = Cells(i, 28).Value
ElseIf Cells(i, 23).Value = Worksheets("Products").Cells(15, 8).Value And Cells(i, 29).Value = Worksheets("Products").Range("B15:B36") And Cells(i + 1, 29).Value = Worksheets("Products").Range("B15:B36") And Cells(i + 2, 29).Value <> Worksheets("Products").Range("B15:B36") Then
Cells(i, 25).Value = Cells(i, 28).Value + Cells(i + 1, 28).Value
ElseIf Cells(i, 23).Value = Worksheets("Products").Cells(15, 8).Value And Cells(i, 29).Value = Worksheets("Products").Range("B15:B36") And Cells(i + 1, 29).Value = Worksheets("Products").Range("B15:B36") And Cells(i + 2, 29).Value = Worksheets("Products").Range("B15:B36") Then
Cells(i, 25).Value = Cells(i, 28).Value + Cells(i + 1, 28).Value + Cells(i + 2, 28).Value
End If
Next i
where cell (i,23) is the column with the codes and cell(15,8) is the cell with the fix product I am first working on to find on the second table. So if the first product belongs to the code on table 1 but the second and third product doesnt, then just write the same demand. if the first and second product belongs to the code and the third doesnt, then just sum the first and the second demand, and so on. I also tried with a for loop but it didnt work since it was evaluating cell by cell, and I need it to evaluate the whole range.
I also tried using Vlookup so It would look for the product type of Table 1 on Table 2. So if the code on Table 1 = the code that belongs to the product on Table 1 then do x
For i = 14 To 76
If Cells(i, 23).Value = Application.WorksheetFunction.VLookup( _
Cells(i, 29).Value, Worksheets("Products").Range("B15:H36"), 7, False) Then
Cells(i, 25).Value = Cells(i,28).Value
End If
Next i
Where (I,23) is the code on table 1 (1007), (i,29) is the product type on table 1 (H102), (i,25) is the consumption and (i,28) is the demand. This is only for the case where the rest of the products doesnt share the same code so there is no sum needed.
So im trying to create a macro in VBA that finds a header e.g. Product number, then pastes all the product numbers and products (the adjacent column) in another workbook (Bill) in the format,
product number - product
until it reaches two blank cells. The problem is the loop runs one too many times and then pastes all the rows followed by "Error" and the red cell because both cells are blank. I've omitted a lot of lines for conciseness, but if it helps im happy to post the rest of it. Ive tried multiple things but just cant fix it. Any help would be appreciated. Thanks in advance.
Set wsDest = Workbooks("Bill.xlsx").Worksheets("Bill")
Lastrow = wsDest.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Offset(RowOffset:=1).Row
Do Until IsEmpty(Cells(i, j)) And IsEmpty(Cells(i, j + 1))
Set ANextFreeCell = wsDest.Cells(Lastrow, "L")
If IsEmpty(Cells(i + 1, j)) Or IsEmpty(Cells(i + 1, j + 2)) Then
ANextFreeCell = "Error"
ANextFreeCell.Interior.Color = RGB(255, 199, 206)
Else
ANextFreeCell = Cells(i + 1, j) & " - " & Cells(i + 1, j + 2)
End If
i = i + 1
Lastrow = Lastrow + 1
Loop
I'm trying to introduce more operations/assign values to variables and cells in a For loop however I am getting an "Object doesn't support this property or method" error because of the line .Cells(.CurrentRowOffset - 1, 2).Value = YesterdaysOpen.
I know I need to qualify it but i thought that was done at the start of the With statement. Obviously given the error it was not, so i tried adding .Range in front, also adding the full address
Worksheets("Data processing").Cells(.CurrentRowOffset - 1, 2).Value
but that generates the same error. I feel like I am missing something in the structure of the loop/syntax but have not located a comparable example i understand either on here or via google (so i'm posting the question).
`With Worksheets("Data processing")
ClosingPrice200Array = .Range(.Cells(FirstRow, 5), .Cells(LastRow, 5)).Value 'pass the first range to the ClosingPrice200Array
LastRow = .Cells(.Rows.Count, 5).End(xlUp).Row ' this assigns the row number of the last used row in column 4 to the variable "LastRow"
LastRowOffset = (LastRow - FirstRow + 1) - MovingAverageLength 'This sets the distance from the end row far enough to stop
'calculating a FORWARD looking average. Even though it is historical data,
'it is working through the data in a forward looking manner,
'from earliest to latest. so it needs to stop roughly 200 rows
'before the end to make sure all the calculations contain at least
'200 data points
With .Cells(FirstRow, 5).Resize(MovingAverageLength) ' reference the first range to sum
For CurrentRowOffset = 0 To LastRowOffset 'defines a For loop starting from zero to
'the row 200 data points before the end of the data
Dma200current = WorksheetFunction.Average(.Offset(CurrentRowOffset))
.Cells(.CurrentRowOffset - 1, 2).Value = YesterdaysOpen
.Cells(.CurrentRowOffset - 1, 3).Value = YesterdaysHigh
.Cells(.CurrentRowOffset - 1, 4).Value = YesterdaysLow
.Cells(.CurrentRowOffset - 1, 5).Value = YesterdaysClose
.Cells(.CurrentRowOffset, 2).Value = TodaysOpen
.Cells(.CurrentRowOffset, 3).Value = TodaysHigh
.Cells(.CurrentRowOffset, 4).Value = TodaysLow
.Cells(.CurrentRowOffset, 5).Value = TodaysClose
.Cells(.Rows.Count).Offset(CurrentRowOffset, 5).Value = Dma200current
DMASlopeCurrent = (Dma200current - Dma200Tminus1) / Dma200Tminus1
.Cells(.Rows.Count).Offset(CurrentRowOffset, 6).Value = DMASlopeCurrent
Dma200Tminus1 = Dma200current
Next
End With
End With
`
You're attempting to use .CurrentRowOffset, which in your code would be the equivalent of:
Worksheets("Data processing").Cells(FirstRow, 5).Resize(MovingAverageLength).CurrentRowOffset
CurrentRowOffset is not a property of the range you're resizing. It's a variable, presumably declared as a Long..?
Change your For.. Next loop to:
Dma200current = WorksheetFunction.Average(.Offset(CurrentRowOffset))
YesterdaysOpen = .Cells(CurrentRowOffset - 1, 2).Value
YesterdaysHigh = .Cells(CurrentRowOffset - 1, 3).Value
YesterdaysLow = .Cells(CurrentRowOffset - 1, 4).Value
YesterdaysClose = .Cells(CurrentRowOffset - 1, 5).Value
TodaysOpen = .Cells(CurrentRowOffset, 2).Value
TodaysHigh = .Cells(CurrentRowOffset, 3).Value
TodaysLow = .Cells(CurrentRowOffset, 4).Value
TodaysClose = .Cells(CurrentRowOffset, 5).Value
.Cells(.Rows.Count).Offset(CurrentRowOffset, 5).Value = Dma200current
DMASlopeCurrent = (Dma200current - Dma200Tminus1) / Dma200Tminus1
.Cells(.Rows.Count).Offset(CurrentRowOffset, 6).Value = DMASlopeCurrent
Dma200Tminus1 = Dma200current
Background:
I have a sheet named RM that I am pulling milestone data from to a sheet named Finance via a loop (loop is per sheets("RM")). Once the data is pulled forward, the sheet is supposed to group items in two subtotals:
1) Group the milestone activities
2) Group the everything that was pulled over during the loop
Here is the code:
Dim i As Integer
Dim LR As Long, FR As Long
FR = Sheets("Finance").Cells(Sheets("Finance").Rows.Count, 1).End(xlUp).Row
Sheets("Finance").Cells(FR + 1, 1).Value = "Raw Materials"
Sheets("Finance").Cells(FR + 1, 7).Value = Sheets("RM").Cells(12, 2).Value
For i = 16 To 358 Step 18
LR = Sheets("Finance").Cells(Sheets("Finance").Rows.Count, 1).End(xlUp).Row
If Sheets("RM").Cells(i, 4) > 0 And Sheets("RM").Cells(i, 2) = "Fixed" Then
'Milestone row
Sheets("Finance").Cells(LR + 1, 1).Value = Sheets("RM").Cells(i, 1).Value
Sheets("Finance").Cells(LR + 1, 7).Value = Sheets("RM").Cells(i, 4).Value
Sheets("Finance").Rows(LR + 1).Font.Bold = True
'Number
Sheets("Finance").Range(Sheets("Finance").Cells(LR + 2, 1), Sheets("Finance").Cells(LR + 9, 1)).Value = Sheets("RM").Cells(i, 1).Value
'Removed middle section, which pulls over data from different columns
'Group Milestone subactivities
If Sheets("Finance").Cells(LR, 1).Value = Sheets("Finance").Cells(LR - 2, 1).Value Then
Sheets("Finance").Range(Sheets("Finance").Cells(LR + 2, 1), Sheets("Finance").Cells(LR + 9, 1)).EntireRow.Group
Else
End If
Else
End If
Next i
Sheets("Finance").Rows(FR + 1).Font.Bold = True
If LR - FR > 1 Then
Sheets("Finance").Range(Sheets("Finance").Rows(FR + 2), Sheets("Finance").Rows(LR)).EntireRow.Group
Else
End If
Issue:
The grouping for the milestone events is not coming over appropriately. When the code runs, only some of the milestones get their grouping, though the overarching grouping occurs.
In a list of 10 milestones, 1 and 10 do not have milestone grouping, but 2-9 do group.
I thought I had an issue with the if-statement itself, that If LR-FR>2 then, but in stepping-through, I found something weird.
As I step-through with F8, I realized that the data that I .copy/.pastespecial does not show up until after one or two loops have occurred. The grouping then shows up for the last visually-added data that was pasted. Then subsequent data shows up until the last bit.
Question:
Is there a way to force the paste to display data? Is there anything else that would cause this activity from Excel/VBA?
Any help in resolution would be appreciated.
Two things happened to work-around the issue:
1) I had to add another line so the Milestone groupings did not end on the same line as the Section grouping (in this case, after the loop in the subroutine posted in the question).
Dim LR as Long
LR = Sheets("Finance").Cells(Sheets("Finance").Rows.Count, 7).End(xlUp).Row
Sheets("Finance").Cells(LR + 1, 7).Value = "-"
Sheets("Finance").Rows(LR + 1).Font.Bold = True
2) I pulled all of the grouping out to the end, after the loops.
The code for grouping ends up looking like:
Dim a as Integer
LR = Sheets("Finance").Cells(Sheets("Finance").Rows.Count, 7).End(xlUp).Row
For i = 5 To LR
If Sheets("Finance").Cells(i, 1).Font.Bold = False Then
Sheets("Finance").Rows(i).EntireRow.Group
Else
End If
Next i
'Group between sheets
a = Sheets("Finance").Columns(1).Find(What:="Not Raw Materials", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Row
Sheets("Finance").Range(Sheets("Finance").Rows(4), Sheets("Finance").Rows(a - 1)).EntireRow.Group
In the end, I had to make sure the grouping was from the smallest increments to the largest increments to ensure that I did not lose functionality of the mass-grouping (subtotal) toggles. I would often lose the last milestone's subtotal toggle.
I have a macro written with vbscript that populated an excel worksheet with data pulled from my database. I need to format a line to have a top border across 3 columns. Nothing I've tried works. Here's where I need the border
objExcel.Cells(rowNum + 2, 6).Value = "SUB TOTAL"
objExcel.Cells(rowNum + 2, 8).Value ="=SUM(H7:H"&finalRowNum&")" 'Extended Cost subtotal'
objExcel.Cells(rowNum + 2, 9).Value ="=SUM(I7:I"&finalRowNum&")" 'low price subtotal'
objExcel.Cells(rowNum + 2, 10).Value ="=SUM(J7:J"&finalRowNum&")" 'list price subtotal'
objExcel.Cells(rowNum + 2, 11).Value = "=H"&finalRowNum + 1&"*L"&finalRowNum + 1 'price quote' 'for included the markup going on the subtotal for all quoted items
objExcel.Cells(rowNum + 2, 12).Value ="2.00"
objExcel.Cells(rowNum + 2, 12).Interior.Color = RGB(255, 255, 153)
I got it to work using this
subTotalRange = "F" &rowNum +2&":L"&rowNum + 2
objWorkSheet.Range(subTotalRange).Borders(8).linestyle= 1