Morning guys,
I have recently been tasked with being the person to update and monitor any VBA issues my currently company has, as the previous employee who was doing such has no left and there are no immediate plans to hire a replacement. Unfortunately my excel and VBA skills are rudimentary put politely, and youtube has only been able to help so much.
There is a macro used in one of the spreadsheets which checks and overwrites certain month end figures. This part of the macro runs fine, and when completed for each client an X should be input to column M (Labelled done) to signify this is done. The column N (labelled skip) is already filled with an X for those that should be skipped due to individual client technicalities.
The macro however appears to be filling in column N with the value x for when a client check is done. Have any of you ever encountered a similar issue with values being incorrectly assigned to the adjacent column?
Sub Values()
Application.ScreenUpdating = False
Dim EndRow As Integer
Dim i As Integer
Dim ValueDate As Date
Dim Cash As Double
Dim Value As Double
Dim APXRef As String
Dim d As Integer
Dim Overwrite As Boolean
Overwrite = Worksheets("Summary").Range("Y2").Value ' from checkboxes
EndRow = Range("J2").End(xlDown).Row
ValueDate = Range("P6").Value
If MsgBox("You are uploading with the following date: " & ValueDate & ", do
you want to continue?", vbYesNo) = vbNo Then Exit Sub
For i = 2 To EndRow
APXRef = Range("J" & i).Value
Value = Range("L" & i).Value
If Range("M" & i) = "" And Range("N" & i) = "" Then
Worksheets("Summary").Activate
r = Range("A:A").Find(APXRef).Row
Range("B" & r).Select
Call GoToClient
d = Range("A10").End(xlDown).Row
If Range("A" & d).Value < ValueDate Then
Range("A" & d + 1).Value = ValueDate
Range("B" & d + 1).Value = Value
Range("D" & d + 1).FormulaR1C1 = "=((RC[-2]/(R[-1]C[-2]+RC[-1]))-1)*100"
Range("E" & d + 1).FormulaR1C1 = "=((((R[-1]C)*(RC[-1]))/100)+R[-1]C)"
Range("H" & d + 1).Value = Range("H" & d).Value
'Save client
If Overwrite = True Then
Call SaveClient
End If
'Return to Flow Tab
Worksheets("Flows").Activate
Range("M" & i).Value = "x"
Else
'skip
Worksheets("Flows").Activate
Range("N" & i).Value = "x"
End If
End If
Application.StatusBar = TabRef & " " & Round(((i - 1) / (EndRow - 1)) *
100, 1) & "% Complete"
Next i
Application.StatusBar = "Value Update Complete"
End Sub
Related
I have VBA code that copies data from one sheet and pastes into a new sheet. The code should loop through each row in the target sheet and paste data if the unique identifiers match. The pasted data in the first row is correct. However, in each consecutive row the data is aggregated
Eg:
Current output
Row 1 - test1
Row 2 - test1
test2
Row 3 -
test1 test2
test3
Desired output
Row 1 - test1
Row 2 - test2
Row 3 - test3
Why is the data aggregating? I suspect it has something to with the loop logic but haven't been able to fix it..
Any leads for rewriting the code to eliminate the aggregation are very much appreciated!!
Option Explicit
Sub Update_Market_Status()
Dim d As Long
Dim j As Long
Dim prev_acts As String
Dim next_acts As String
Dim ws As Object
Dim status_report As Object
Dim lastRow As Long
Dim last_project As Long
Set ws = ThisWorkbook.Sheets("Project plan")
Set status_report = ThisWorkbook.Sheets("Status Report")
lastRow = ThisWorkbook.Sheets("Project plan").Cells(Rows.Count, "D").End(xlUp).Row + 1
last_project = ThisWorkbook.Sheets("Status Report").Cells(Rows.Count, "C").End(xlUp).Row + 1
On Error Resume Next
For j = 8 To last_project
If ThisWorkbook.Sheets("Status Report").Range("C" & j).Value <> "" Then
For d = 2 To lastRow
If ws.Range("V" & d).Value = ThisWorkbook.Sheets("Status Report").Range("I" & j).Value Then
If LCase(ws.Range("N" & d).Value) = "y" Then
If LCase(ws.Range("T" & d).Value) = "c" Then
If prev_acts = vbNullString Then
prev_acts = "'- " & ws.Range("D" & d).Value
Else
prev_acts = prev_acts & vbLf & "- " & ws.Range("D" & d).Value
End If
ElseIf LCase(ws.Range("T" & d).Value) = "o" Or LCase(ws.Range("T" & d).Value) = vbNullString Then
If next_acts = vbNullString Then
next_acts = "'- " & ws.Range("D" & d).Value
Else
next_acts = next_acts & vbLf & "- " & ws.Range("D" & d).Value
End If
End If
End If
End If
Next d
ThisWorkbook.Sheets("Status Report").Range("E" & j).Value = prev_acts ' Previous Actions
ThisWorkbook.Sheets("Status Report").Range("F" & j).Value = next_acts ' Next Actions
End If
Next j
End Sub
I'm writing a code that calculate number automatically every time you edit a sheet. But somehow the code I wrote is not functioning properly that it gives a run-time error. I checked the cells and range but they are all valid and correct. All of the inputs and variables involved are simple integers (no more than 3 digits).
I just got a work assignment to automate some excel sheets at work and I just learned vba from ground up recently.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Integer
Dim i As Byte
i = 5
For i = 5 To 12
If Worksheets("Sheet1").Range("D" & i).Value = "" Or Worksheets("Sheet1").Range("D" & i).Value = 0 Then
A = Worksheets("Sheet1").Range("E" & i).Value - Worksheets("Sheet1").Range("C" & i).Value
Worksheets("Sheet1").Range("F" & i).Value = A
Else
Worksheets("Sheet1").Range("F" & i).Value = Worksheets("Sheet1").Range("D" & i).Value * Worksheets("Sheet1").Range("B" & i).Value _
+ Worksheets("Sheet1").Range("E" & i).Value - Worksheets("Sheet1").Range("C" & i).Value
End If
Next i
End Sub
It gives a run-time error
Give this a shot and let me know what error you get:
Private Sub Worksheet_Change(ByVal Target As Range)
'Only run if something changes in column D or E
If Target.Column = 4 Or Target.Column = 5 Then
'Turn off any events so that we don't encounter recursion
Application.EnableEvents = False
'This will help readability a bit
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Sheet1")
Dim A As Integer
Dim i As Long
'This needs to be removed - it's irrelevant as i is used as an iterable on the next line
'i = 5
For i = 5 To 12
If sht.Range("D" & i).Value = "" Or sht.Range("D" & i).Value = 0 Then
'What's the point of using a variable here?
A = sht.Range("E" & i).Value - sht.Range("C" & i).Value
sht.Range("F" & i).Value = A
Else
'Order of operations - is that important here?
'Are we certain these fields are numeric?
sht.Range("F" & i).Value = sht.Range("D" & i).Value * sht.Range("B" & i).Value _
+ sht.Range("E" & i).Value - sht.Range("C" & i).Value
End If
Next i
'Turn it back on once we're done
Application.EnableEvents = True
End If
End Sub
I have a worksheet with the following values
I want to, using an equation if possible, rearrange these values into three columns, in another worksheet, based on whether they are low, medium or high risk, like so
Pay no attention to the coloring and borders, I can add that later (or use conditional formatting).
Questions: could someone provide either a minimal working example (MWE) or the equation to use to make convert one table into three side by side tables.
I would use VBA to solve this issue:
Sub Sortdata()
Dim wsRisk As Worksheet, wsThisSheet As Worksheet
Dim colHigh As Long, colMed As Long, ColLow As Long
colHigh = 3
colMed = 3
ColLow = 3
Set wsThisSheet = ActiveSheet
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Risk"
End With
Set wsRisk = Worksheets("Risk")
wsRisk.Range("A1").Value = "Risk of Responsibility"
wsRisk.Range("A2").Value = "High Risk"
wsRisk.Range("C2").Value = "Medium Risk"
wsRisk.Range("E2").Value = "Low Risk"
lastrow = wsThisSheet.Cells(Rows.Count, "B").End(xlUp).Row
For x = 2 To lastrow
If wsThisSheet.Cells(x, 4).Value = "High" Then
wsRisk.Range("A" & colHigh & ":B" & colHigh).Value = wsThisSheet.Range("B" & x & ":C" & x).Value
colHigh = colHigh + 1
ElseIf wsThisSheet.Cells(x, 4).Value = "Med" Then
wsRisk.Range("C" & colMed & ":D" & colMed).Value = wsThisSheet.Range("B" & x & ":C" & x).Value
colMed = colMed + 1
ElseIf wsThisSheet.Cells(x, 4).Value = "Low" Then
wsRisk.Range("E" & ColLow & ":F" & ColLow).Value = wsThisSheet.Range("B" & x & ":C" & x).Value
ColLow = ColLow + 1
End If
Next x
End Sub
I'm concatenating 4 different formula based columns into one using VBA (to be able to change formatting while still concatenating). The concatenating VBA code works, but when the 4 individual columns update and pull the new information, the concatenated column doesn't change.
My concatenated code is this and it lies in column D or 4:
Sub joint1()
ActiveSheet.Range("a2", ActiveSheet.Range("a2").End(xlDown)).Select
Row = 2
Col = 4
For Each Cell In Selection
AE = Cells(Row, Col + 15)
Name = Cells(Row, Col + 9)
SC = Cells(Row, Col + 16)
PM = Cells(Row, Col + 10)
Cells(Row, Col) = Name & Chr(10) & "(" & AE & " - " & SC & ")" & Chr(10) & PM & " - PM"
With Cells(Row, Col)
.ClearFormats
.Characters(1, Len(Name)).Font.Bold = True
End With
Row = Row + 1
Next
End Sub
If you know how to add a feature to help my problem, I would be very appreciative!
Try this:
Option Explicit
Sub joint1()
Dim iRow As Long
Dim iCol As Long
Dim rng As Range
Dim rngSelect As Range
Dim Name As String
Set rngSelect = ActiveSheet.Range("a2", ActiveSheet.Range("a2").End(xlDown))
iRow = 2
iCol = 4
For Each rng In rngSelect
Name = Cells(iRow, iCol + 9)
Cells(iRow, Col) = "=M" & iRow & Chr(10) & " & ""("" & S" & iRow & " & "" - "" & T" & iRow & " & "")"" &" & Chr(10) & "N" & iRow & " & ""-PM"""
With Cells(iRow, iCol)
.ClearFormats
.Characters(1, Len(Name)).Font.Bold = True
End With
iRow = iRow + 1
Next
End Sub
This code creates a formula in each cell, rather than just copying the values.
The job could probably be done just as well with an excel formula. The formatting doesn't work with my version of excel (2007).
I am trying to create a pop up that returns either an entire row of data or just the first 3 columns whenever column E is greater than 1. The tricky part is that this has to happen when the "close" button in an another popup that collects data is clicked.
So far I can only get it to return each record in a separate popup by using a loop but I would like to show all cases in the same pop up. Here's what I have:
column A is is Last Name
column B is First Name
column C is a location number
column D is a date
column E is a simple count cell that shows how many times a First and Last Name occur
Private Sub cmdClose_Click()
Dim wsx As Worksheet
Set wsx = Worksheets("SuspectData")
Dim xRow As Long
Dim countingX As Integer
countingX = 2
'find last row in database'
xRow = wsx.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row
'prompt warning'
With wsx
Do While countingX <= xRow
If Range("E" & countingX) > 1 Then
MsgBox ("Suspect " & Range("B" & countingX) & " " & Range("A" & countingX) & " at Unit " & Range("C" & countingX))
End If
countingX = countingX + 1
Loop
End With
Unload Me
End Sub
Thank you!
If you want all cases to return inside of one popup, you should add the cases to a string, and have the popup call the string outside of the loop
Dim s as String
s = ""
Do While countingX <= xRow
If Range("E" & countingX) > 1 Then
s = s & vbnewline & "Suspect " & Range("B" & countingX) & " " & Range("A" & countingX) & " at Unit " & Range("C" & countingX)
End If
countingX = countingX + 1
Loop
MsgBox s