I'm new to VBA but want to automate certain forms in my company.
The code i'm trying to write focusses on entering data in a table based on an Input sheet and then copies on cell a few rows down depending on one variable (amount of cable cores).
The first routine copies the data to the table and then calls upon the second routing to copy the data down. The problem that i'm encountering is that my variables are not updated with the info from the cell, they stay 0.
It's probably an easy fix but i can't seem to solve it. Any help would be much appreciated.
Sub Data_input()
'Inputs the values from input to Overview sheet
next_row = ws1.Range("F" & Rows.Count).End(xlUp).Offset(1).Row
ws1.Cells(next_row, 2).Value = Range("Cable_Number").Value
ws1.Cells(next_row, 3).Value = Range("Equipm_Name").Value
ws1.Cells(next_row, 4).Value = Range("Description").Value
ws1.Cells(next_row, 9).Value = Range("Section").Value
ws1.Cells(next_row, 6).Value = Range("Cable_Number").Value
Application.Run "Module3.Data_Copy"
End Sub
Sub Data_Copy()
Dim b1 As Long
Dim lr As Long
Dim x1 As Long
'set amount of cores in b, b is used to determine amount of copy cycles.
b1 = ws2.Range("Cores").Value
x1 = b1 - 1 'adjusted, because one line is already filled in.
Do Until x1 = 0
'Find the last row with data:
lr = ws1.Cells(Rows.Count, "F").End(xlUp).Row
'Copies the Cablenumber sleeve until all Cores are done:
ws2.Range("Cable_Number").Copy Destination:=ws1.Range("F" & lr + 1)
x1 = x1 - 1
Loop
Application.CutCopyMode = False
End Sub
I managed to solve the problem by adding the explicit tag of the worksheet to each cell value that I want to assign to a variable. Sorry for the initial sloppy question. Friday afternoon and frustrated about not being able to fix the code... Thank you for the input.
Related
I have a spreadsheet that has an add-in that is constantly feeding in data. The data changes from time to time. I need a macro that will create a new line item storing this data with a time stamp each time the value in any one of the 3 cells changes.
In cells J3, L3, N3 are the values that are feeding in live data that will change. Whenever the value in J3, L3, or N3 changes I want the values in those cells to copy and paste values in a new line item in cells B, D, F with a time stamp added in column A.
I'm a novice so go easy on me. Below is the code, which doesn't work because it only updates one column if one of the values changes, but I want all 3 values to get logged regardless if its only the data in J3, L3, N3 that change:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$J$3" Then
SPOT1 = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row + 1
Sheets("Sheet1").Range("B" & SPOT1).Value =
Sheets("Sheet1").Range("J3").Value
Sheets("Sheet1").Range("A" & SPOT2) = "=Now()"
End If
If Target.Address = "$L$3" Then
SPOT2 = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row + 1
Sheets("Sheet1").Range("D" & SPOT2).Value =
Sheets("Sheet1").Range("L3").Value
Sheets("Sheet1").Range("A" & SPOT2) = "=Now()"
End If
If Target.Address = "$N$3" Then
Spot3 = Sheets("Sheet1").Cells(Rows.Count, "F").End(xlUp).Row + 1
Sheets("Sheet1").Range("F" & Spot3).Value =
Sheets("Sheet1").Range("N3").Value
Sheets("Sheet1").Range("A" & Spot3) = "=Now()"
End If
End Sub
Any help is appreciated. Thank you.
I have a raw data table consisting of columns as time periods and row labels as the names of technicians. The data filled is the registration number of the car.
I had to calculate two things:
The number of hours each person has spent working in a day
The number of hours spent on one car by individual technicians involved.
I was able to achieve the first task by using pivot tables but am stuck at the second one.
Kindly suggest some easy method.
Thanks
Attached is a reference image dummy data.
You can use this code which makes a new data table from your existing table and gives you data in a format from which making Pivot table is feasible,
Sub K()
Dim LR As Long, i As Long, j As Long, LR1 As Long
Dim reg As String, person As String
Dim DT As Date
Range("AB:AD").Delete Shift:=xlToLeft
Sheets("Sheet1").Select
LR = Range("A" & Rows.Count).End(xlUp).Row
For j = 5 To LR
For i = 4 To 25
If Cells(j, i).Value = "" Then
Else
reg = Cells(j, i).Value
LR1 = Range("AC" & Rows.Count).End(xlUp).Row
DT = Cells(j, 1).Value
person = Cells(j, 2).Value
Range("AC" & LR1).Offset(1, 0).Value = reg
Range("AC" & LR1).Offset(1, 1).Value = person
Range("AC" & LR1).Offset(1, -1).Value = DT
End If
Next
Next
Range("AB1").FormulaR1C1 = "Date"
Range("AC1").FormulaR1C1 = "Reg. No."
Range("AD1").FormulaR1C1 = "Person"
Range("AE1").FormulaR1C1 = "Count"
LR1 = Range("AC" & Rows.Count).End(xlUp).Row
Range("AE2:AE" & LR1).Value = 0.5
End Sub
This table can be used as a source for PIVOT and every time you run the code it will give a complete data set based on data given.
I don't think you can achieve this using pivot table as the data you wish to be present in your new table namely the car's registration number, pivot won't let you put these registration number as row/column entries.
You should take help of VBA.
you can use loop to read this data and create a count for every car, you should use if else loop. to set condition on which entry should it count and which it shouldn't.
I have a spreadsheet, BO2009, that is 300k rows long. Only one column contains a formula The others are all pasted values so only one formula needs to be calculated in the entire workbook. Here is the formula: =IFERROR(INDEX('RE2009'!H:H,MATCH('BO2009'!A2,'RE2009'!A:A,0)),1) This formula is copied down to the bottom of the sheet, so 300k times.
RE2009 sheet has 180k rows. 'RE2009'!H:H contains decimal numbers and 'RE2009'!A:A, 'BO2009'!A:A contain ID codes--an 8 character combination of numbers and letters. Both 'RE2009'!A:A, 'BO2009'!A:A are formatted as general.
I use INDEX/MATCH all the time and while most of my spreadsheets are not 300k long, 60k-100k is typical. Right now it takes a couple minutes of my CPU devoting 99% to Excel in order to finish the calculation.
Is that normal? Is there any way to improve Excel's performance?
On top of that I am getting inaccurate results: instead of 0.3 the lookup produces an error.
As suggested, I have filtered the BO2009 sheet down to 80k rows, but still have the same issues. I decided to look at a single formula in particular: =IFERROR(INDEX('RE2009'!H:H,MATCH('BO2009'!A108661,'RE2009'!A:A,0)),1) to see if it worked correctly. The ID that it is looking for with the MATCH function is the 3rd entry in the lookup array, but it still isn't able to produce the correct value (0.3)
It seems that you've found a satisfactory solution to your problem(s) but as a matter of curiosity, you may wish to time this against your current formula based solution to see if there is a measurable increase in speed.
Sub index_match_mem()
Dim v As Long, vVALs As Variant, vTMP As Variant
Dim dRE2009 As Object
Debug.Print Timer
Application.ScreenUpdating = False
With Worksheets("RE2009")
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count, 8)
vTMP = .Cells.Value2
End With
End With
End With
Set dRE2009 = CreateObject("Scripting.Dictionary")
dRE2009.CompareMode = vbTextCompare
For v = LBound(vTMP, 1) To UBound(vTMP, 1)
If Not dRE2009.exists(vTMP(v, 1)) Then _
dRE2009.Add Key:=vTMP(v, 1), Item:=vTMP(v, 8)
Next v
With Worksheets("BO2009")
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count - 1, 2).Offset(1, 0)
vVALs = .Cells.Value2
For v = UBound(vVALs, 1) To LBound(vVALs, 1) Step -1
If dRE2009.exists(vVALs(v, 1)) Then
vVALs(v, 2) = dRE2009.Item(vVALs(v, 1))
Else
vVALs(v, 2) = 1
End If
Next v
.Cells = vVALs
End With
End With
End With
dRE2009.RemoveAll: Set dRE2009 = Nothing
Application.ScreenUpdating = True
Debug.Print Timer
End Sub
This will produce static values in column B of the BO2009 worksheet. The elapsed start and stop in seconds will be in the VBE's Immediate window (Ctrl+G)
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub
I'm relatively new to VBA and I'm trying to write a macro that will compare two columns of data (first and last names). While traversing the column, any time first name = last name (ie. they're both blank or say UNKNOWN) I want the cell in the 9th column to be cleared and the cell in the 10th column to get the value UNKNOWN.
As of now, the code correctly recognizes any time when the first and last name are identical. My problem is that any time first name is a sub-string of any last name (ie. cell I2=David J2=Jones , I3=Joseph J3=Davidson) David gets compared with Davidson and is subsequently erased.
I've spent a while looking for similar problems and I haven't been able to adapt anything to my problem thus far. Thanks in advance for any help.
Sub compare_cols()
Dim Report As Worksheet
Dim i As Integer, j As Integer
Dim lastRow As Integer
Set Report = Excel.ActiveSheet
lastRow = Report.UsedRange.Rows.count
Application.ScreenUpdating = False
For i = 1 To lastRow ' This will find all identical pairs of cells in I,J (blank, blank) or (unknown, unknown). I stays blank, J gets UNKNOWN
For j = 1 To lastRow ' I think its currently erasing any matches (ex. if someones first name is James, it will get erased if there is a last name jameson)
If InStr(1, Report.Cells(j, 10).Value, Report.Cells(i, 9).Value, vbTextCompare) > 0 Then
Report.Cells(i, 9).Value = ""
Report.Cells(i, 10).Value = "UNKNOWN"
Exit For
Else
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Unlike some other languages, you can compare strings in vba just using the "=" sign and that will find exact matches, which is what it appears you are looking for. Try
if Report.Cells(j, 10) = Report.Cells(i, 9) etc.