I am fairly new to Excel and VBA programming. Though I have experience in both visual basic and PHP. So the basics understanding is there.
Wow, this is hard to explain in a good way...
This might not be the best way to solve this but this is how I have solved it right now.
A total of 3 sheets. sheet1 - A summary of other sheets. Sheet2, some data and user input. Sheet3 - Data.
The user inputs the length of a steel bar in sheet2. The user also adds other values that adds weight on the steel bar. in sheet 1 a summary of the loads are calculated. one of the cells shows only the load on the bar. Sheet3 have the maximum loading info pr. length of steel bar. I want the summary cell in sheet1 to be red of the value is greater than the maximum loading in sheet3.
So I want a macro to run every time the cell in sheet1 changes by the user input in sheet2. the macro search and cross check the values and changes the color of the cell in sheet1.
What is a good way of solving this?
To make it a bit more complicated the user can choose from 4 separate steel bars with different loading data.
to set it up a test I have done all in on test sheet, but I cant get the macro to run for some reason.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("E4")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Range("E4").Value > Range("E14").Value Then
Range("E4").Interior.ColorIndex = 37
End If
End If
End Sub
You are comparing the cells value in same worksheet. You need mention which worksheet's cell to compare. In addition, You need set the code for worksheet(summary) activated and worksheet(summary) cell value changed.
worksheet activated:
Private Sub Worksheet_Activate()
Dim MyWorkbook As Workbook
Dim MySummary As Worksheet
Dim MyData As Worksheet
Set MyWorkbook = ActiveWorkbook
Set MySummary = MyWorkbook.Sheets("Summary")
Set MyData = MyWorkbook.Sheets("Data")
If MySummary.Range("E4").Value > MyData.Range("E14").Value Then
MySummary.Range("E4").Interior.ColorIndex = 37
Else
MySummary.Range("E4").Interior.ColorIndex = 0
End If
End Sub
worksheet value change:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyWorkbook As Workbook
Dim MySummary As Worksheet
Dim MyData As Worksheet
Set MyWorkbook = ActiveWorkbook
Set MySummary = MyWorkbook.Sheets("Summary")
Set MyData = MyWorkbook.Sheets("Data")
If MySummary.Range("E4").Value > MyData.Range("E14").Value Then
MySummary.Range("E4").Interior.ColorIndex = 37
Else
MySummary.Range("E4").Interior.ColorIndex = 0
End If
End Sub
Related
I have one Command Buttons been set up for each product line. Totally, I have more than 20 buttons on Sheet 1.
If I click any of them with quantity more than 1, the product name will be copied and pasted to Order List sheet.
I try to use the Offset to paste it to blank column under line A from A2 in Order List.
However, it is only replacing A2 rather than paste to A3 after I click another button.
Code details for first two buttons are as following (all 20 buttons should be same code, as they will not be clicked in order. As long as it picks up the blank column, it should be fine):
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Set wb = ActiveWorkbook
Set wsSource = wb.Sheets("Sheet1")
Set wsDest = wb.Sheets("Order List")
'Stop if report not filled in fully
If wsSource.Range("G28").Value < 1 Then
MsgBox "Please Amend Quantity"
Exit Sub
End If
wsSource.Range("B28").Copy wsDest.Range("A1").Offset(1,0)
wsDest.Range("A:D").EntireColumn.AutoFit
End Sub
Private Sub CommandButton2_Click()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Set wb = ActiveWorkbook
Set wsSource = wb.Sheets("Sheet1")
Set wsDest = wb.Sheets("Order List")
'Stop if report not filled in fully
If wsSource.Range("G28").Value < 1 Then
MsgBox "Please Amend Quantity"
Exit Sub
End If
wsSource.Range("B28").Copy wsDest.Range("A1").Offset(1,0)
wsDest.Range("A:D").EntireColumn.AutoFit
End Sub
Please advise me. Many thanks
Use this instead which will find the last used cell and then move down to the next cell (your code never updates the destination cell, it is fixed at A2). What sort of buttons are these - you should be able to avoid repeating your code 20 times.
wsSource.Range("B28").Copy wsDest.Range("A" & rows.count).end(xlup).Offset(1,0)
I want to use if condition formula to calculate the cube via vba macro button. I write code and its working is fine but code is show in formula bar and also working with formula come from vba macro and remain their, I want that this formula did not should be show in formula bar and the calculation should be done only via macro button when i press it. here is my code. Thanks
Sub CalCubMeter()
Worksheets("sheet1").Range("d3:d21").Formula = "=if(c3=C3,PRODUCT($c3^3),""-"")"
End Sub
Something along the lines of:
Public Sub CubeColumnC
Dim wb as Workbook
Dim ws as Worksheet
Dim sourceRange as Range
Dim sourceArr()
Dim i as long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1") 'change to as needed
Set sourceRange = ws.Range("C3:C21")
'Assign column c values to array
sourceArr = Application.Transpose(sourceRange.Value)
With ws
For i = Lbound(sourceArr) To Ubound(sourceArr) 'Write back out to col D
If .Cells(2+i, "C") = vbNullString Then 'if blank
.Cells(2+i, "D") = "-"
Else
.Cells(2+i,"D") = sourceArr(i)^3 'Calc the Cube value
End If
Next i
End With
End Sub
I ignored your C3 = C3 as this is always True, amend as you see fit.
Edit: Application.WorksheetFunction.Power(sourceArr(i),3) changed to sourceArr(i)^3 for Cube value
I've been looking around for a generic code and modify but I am not able to solve my problem.
I have a working file including many rows. Each line is supposed to have only one color fill (RGB 0,204,0). I would like to know if it possible to automatically loop (without using action button) into my document and highlight the rows via MsgBox in which I have the same color.
Thanks !
I recorded a macro to see what is the code of RGB(0,204,0) and I found that it's 52224.
Now I assumed that your Worksheet name is Sheet1 and the name of your Specific Range is MySpecificRange
Option Explicit
Sub ChangeTheColorofSpecificRange()
Dim wb As Workbook
Dim ws As Worksheet
Dim MyRange As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set MyRange = Range("MySpecificRange")
If MyRange.Interior.Color <> 52224 Then
MsgBox "Your SpecificRange doesn't have your desired background color so I'm going to do it!"
MyRange.Interior.Color = 52224
End If
End Sub
After you write this code in your module, you can run this by clicking F5 or either go to Developer tab, Macros section and Run the macro.
As long as question is not enough clear, here are some another possible solutions:
If you are looking for Worksheet_Change() event as #Romcel Geluz asked, please copy below code into your Worksheet object page.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim ws As Worksheet
Dim MyRange As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set MyRange = Range("MySpecificRange")
If MyRange.Interior.Color <> 52224 Then
MsgBox "Your SpecificRange doesn't have your desired background color so I'm going to do it!"
MyRange.Interior.Color = 52224
End If
End Sub
In this example, whatever you do/type/change in your worksheet, if your SpecificRange is not in your desired color, it will change it with that.(And inform you with the fancy MsgBox!)
Or if you want some code to change the background color of your SpecificRange at the beginning of your workbook, when you open it, copy this below code to the ThisWorkbook sheet.
Option Explicit
Private Sub Workbook_Open()
Dim wb As Workbook
Dim ws As Worksheet
Dim MyRange As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set MyRange = Range("MySpecificRange")
If MyRange.Interior.Color <> 52224 Then
MsgBox "Your SpecificRange doesn't have your desired background color so I'm going to do it!"
MyRange.Interior.Color = 52224
End If
End Sub
Thank you very much #Mertinc
My range is (C27:G48)
However, I was wondering if the following can be done : when the loop is going to find the specific color (0,204,0), it's going to look the text of the cell : i.e. EXCELLENT (80) and copy/paste the numerical value into the col H. My numbers are going from 0 ; 5; 20 ; 40 ; 60 ; 80 ; 100.
If the loop find two cells with the color (0,204,0) the B column need to be colored (0,0,255)
Finnaly, if the result in the specific text is 0, the col H related need to be colored in (255,0,0).
I am very new to VBA coding and don't have very good understanding of what I am doing to be honest. But here I go.
I am looking to see if:
Can VBA codes have dyname values? So instead of the code saying execute on a set sheet (e.g "Sheet1") that value changes depending a value in a certain cell.
To trigger a VBA on another workbook. For example I want to run a VBA from Workbook A that triggers a VBA on Workbook B.
To fully explain I want to open Workbook A (and Workbook B if needed, it doesn't matter) and click a button that runs a VBA on Workbook B but on a certain Sheet depending on the value of a cell in Excel A (if the cell says "sheet3" the VBA runs on "sheet3" on Workbook B). I also want cells in Workbook A to reference cells in Workbook B but the the sheet name to by dynamic. For example I have pasted the basic cell reference bellow but instead of having Sheet1 I want it to change depending on the value in a cell.
='[Workbook B.xlsx]Sheet1'!$A$4
I know this sounds very complicates and confusing, but if I could get any help that would be greatly appreciated.
Sub ReportStepOne()
Dim myRow As Long
myRow = 4
Rows(myRow).Value = Rows(myRow).Value
Dim rng As Range
Set rng = Range("A4:AC200")
rng.Cut rng.Offset(1, 0)
Range("A1:AC1").Copy Range("A4:AC4")
End Sub
I want to:
edit this code to make it fire on a certain sheet
make it so the sheet name is referenced to whatever is in cell A o Sheet2 in Report.xlsm.
Run a macro in Report.xlsm that runs the above script (which is called "StepOne" in a file called "Historical Data.xlsm"
The code below takes the value of cell A4 on sheet2 in Reports.xlsm and sets the ws variable to the sheet in Historical data.xlsm which is then used for the rest of the code. If possible I'd advise against having your subs spread out over multiple projects but that is just my opinion. I think it is easier to use proper referencing like below.
Since you want a button trigger on the Report.xlsm I'd suggest moving this code to that workbook. If properly referenced it you can open, edit, save and close any workbook from a single project which again, in my opinion is easier than calling subs in a different project.
Sub ReportStepOne()
Dim wbHis As Workbook, wbRep As Workbook
Dim strWsName As String
Dim ws As Worksheet
Set wbHis = Workbooks("Historical data.xlsm")
Set wbRep = Workbooks("Reports.xlsm")
strWsName = wbRep.Worksheets("Sheet2").Cells(4, 1)
Set ws = wbHis.Worksheets(strWsName)
With ws
With .Rows(4)
.Value = .Value
End With
With .Range("A4:AC200")
.Cut .Offset(1, 0)
End With
.Range("A1:AC1").Copy .Range("A4:AC4")
End With
End Sub
To trigger a VBA on another workbook
Option Explicit
Sub RunVBA()
Dim xlApp As Excel.Application
Dim xlWorkBook As Workbook
Set xlApp = New Excel.Application
Set xlWorkBook = xlApp.Workbooks.Open("C:\Users\Om3r\Desktop\Book1.xlsm")
xlApp.Visible = True
xlWorkBook.Application.Run "Module1.SubName" ' Modulename.Subname
End Sub
To reference worksheet use
Sub CopyRange()
'// From sheet1 to sheet2
Worksheets(2).Range("A1").Value = Worksheets(1).Range("A1").Value
End Sub
I have a very complex workbook with many tabs. The tabs may have either normal data or formulas in various cells. In the case of formulas, the formulas may be nested from one sheet to the next (i.e. a formula on sheet1 refers to a formula on sheet2 which in turn refers to a formula on sheet3, etc.).
I have a hidden tab that contains the following: source sheet, source range, target sheet, and target range.
A named range has been created over these 4 fields and all applicable rows.
When we wish to save data to the database, we loop through every row in the range mapping and copy the data from the source sheet/range to the target sheet/range. After this, the applicable data is serialized into XML and sent to a web service to be saved.
The problem that we wish to resolve is that we want to mark a cell on a hidden sheet when a change is made by the user to a source range. Since formulas can be nested, the Worksheet_Change event does not pick up the change.
Since a change on one sheet may affect another sheet that is not the active sheet, the Workbook_SheetChange event does not catch the change either.
Is there any way form me to catch when a sheet defined in the mapping is changed, even if it is the result of a formula change several levels deep?
Edit
Thank you for your responses. I was attempting to find the fastest and least process intensive way to determine if data changes within a monitored range. The data may consist of actual data or of nested formulas.
My research showed that I could not actually achieve this result by taking range intersections as I could not detect if the data within a monitored range was modified. This is due to the fact that the monitored range may not be on the active sheet and also may contain formulas.
I have shown the method used to actually detect a change below. If there is any feedback on a better way to achieve the same result, I would appreciated it.
Worksheet_Change event will not work if a cell value is changed by a formula, you need Worksheet_Calculate.
Check out my example workbook here.
And Here for the WebPage of example codes
There is no "easy" way to detect if a nested formula has changed when the formula being monitored is not on the active sheet. While my hope was to detect the modified range and use an intersection of ranges to set a flag, this was not possible because the Worksheet_Change event does not work on formulas and the Workbook_SheetChange event only works on the active sheet. Since my workbooks have over 20+ tabs and 20 - 30 ranges being monitored, this approach does not work. This approach was desired for speed purposes.
Instead, the workbook will need to "check" to see if the current values are the same as the last time the save to database event was called. If not, a dirty flag will be set.
The code for this approach is provided below.
An example of the mapping range is shown in the picture below though in practice there are 20-30 rows comprising this range.
There are three other sheets where Sheet3 contains actual data in A1:H1 and Sheet2 has formulas pointing to Sheet3. Sheet1 has formulas pointing to Sheet2.
As the mapping range indicates, we are looking at a range on Sheet1, even though changes may be made to Sheet3.
The code used is as provided below.
Option Explicit
Public Sub DetermineIfEditOccurred()
Dim oMappingRange As Range
Dim szSourceTab As String
Dim szSourceRange As String
Dim oSourceRange As Range
Dim szTargetTab As String
Dim szTargetRange As String
Dim oTargetRange As Range
Dim oWorksheetSource As Worksheet
Dim oWorksheetTarget As Worksheet
Dim oRangeIntersection As Range
Dim nRowCounter As Long
Dim nCellCounter As Long
Dim szSourceValue As String
Dim szTargetValue As String
Dim oCell As Range
Dim bIsDirty As Boolean
If Range(ThisWorkbook.Names("DirtyFlag")).Value = 0 Then
Set oMappingRange = Range(ThisWorkbook.Names("Mapping"))
For nRowCounter = 1 To oMappingRange.Rows.Count
szSourceTab = oMappingRange(nRowCounter, 1)
szSourceRange = oMappingRange(nRowCounter, 2)
szTargetTab = oMappingRange(nRowCounter, 3)
szTargetRange = oMappingRange(nRowCounter, 4)
Set oWorksheetSource = ThisWorkbook.Worksheets(szSourceTab)
Set oWorksheetTarget = ThisWorkbook.Worksheets(szTargetTab)
Set oSourceRange = oWorksheetSource.Range(szSourceRange)
Set oTargetRange = oWorksheetTarget.Range(szTargetRange)
nCellCounter = 1
For Each oCell In oSourceRange.Cells
szSourceValue = oCell.Value
If szSourceValue = "#NULL!" Or _
szSourceValue = "#DIV/0!" Or _
szSourceValue = "#VALUE!" Or _
szSourceValue = "#REF!" Or _
szSourceValue = "#NAME?" Or _
szSourceValue = "#NUM!" Or _
szSourceValue = "#N/A" Then
szSourceValue = ""
End If
szTargetValue = GetCellValueByPosition(oTargetRange, nCellCounter)
If szSourceValue <> szTargetValue Then
Range(ThisWorkbook.Names("DirtyFlag")).Value = 1
bIsDirty = True
Exit For
End If
nCellCounter = nCellCounter + 1
Next
If bIsDirty Then
Exit For
End If
Next
End If
End Sub
Public Function GetCellValueByPosition(oRange As Range, nPosition As Long) As String
Dim oCell As Range
Dim nCounter As Long
Dim szValue As String
nCounter = 1
For Each oCell In oRange
If nCounter = nPosition Then
szValue = oCell.Value
Exit For
End If
nCounter = nCounter + 1
Next
GetCellValueByPosition = szValue
End Function
The Workbook_SheetChange event is as follows:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DetermineIfEditOccurred
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "MAPPING" Then
Call DetermineIfEditOccurred
End If
End Sub