I have made some code in VBA and when running it manually it runs just fine. My problem is when assigning the code to a button in Excel it runs the full script, but misses out on a calculation in the script (the column where the calculations is supposed to be at is empty). Anyone who knows why?
My code for the calculation in VBA looks like this and is part of a larger script:
'Calculate Share of portfolio %
secondvalue = WorksheetFunction.Sum(Range("B6:B" & m))
For m = 6 To Rows.Count
If Cells(m, 2).Value <> "" Then
Cells(m, 3).Value = Cells(m, 2).Value / secondvalue
End If
Next m
I figured it out. I think it came down to if I was in the sheet or not. I changed the code to:
With Worksheets("Tabeller")
If WorksheetFunction.CountA(.Range("B6:B" & .Rows.Count)) > 0 Then
secondvalue = WorksheetFunction.Sum(.Range("B6:B" & m))
For m = 6 To .Rows.Count
If .Cells(m, 2).Value <> "" Then
.Cells(m, 3).Value = .Cells(m, 2).Value / secondvalue
End If
Next m
Else
MsgBox "The range B6:B" & .Rows.Count & " is empty."
End If
End With
Related
I have a problem with my code, an error appears, and I don;t understand why. The error is:
"Compile error: Next without For"
I do not understand why it is like that. I am new to coding so any help and comments are more than welcome.
This is the code, the Next which is pointed as the one without For is provided a comment.
Sub CGT_Cost()
startrow = Worksheets("GUTS").Cells(10, 1) 'Here I put 1
endrow = Worksheets("GUTS").Cells(11, 1) 'Here I put 1000
For x = endrow To startrow Step -1
If Cells(x, "Q").Value = "Sale" Then
If Cells(x, "D").Value = "1" Then
For i = 1 To 1000
If Cells(x - i, "R").Value <> "1" Then
Next i
Else
Range("G" & x).FormulaR1C1 = "=R[-" & i & "]C/R[-" & i & "]C[-1]*RC[-1]"
End If
End If
End If
Next x
End Sub
Thank you all in advance,
with best regards,
Artur.
Every For statement with a body must have a matching Next, and every If-Then statement with a body must have a matching End If.
Example:
For i = 1 To 10 '<---- This is the header
Hello(i) = "Blah" '<---- This is the body
Next i '<---- This is the closing statement
You have part of the body of your If statement inside your For i loop, and part of it outside. It has to be either ALL inside or ALL outside. Think through the logic and see what it is you want to do.
you have overlapping loops-perhaps
Sub CGT_Cost()
startrow = Worksheets("GUTS").Cells(10, 1) 'Here I put 1
endrow = Worksheets("GUTS").Cells(11, 1) 'Here I put 1000
For x = endrow To startrow Step -1
If Cells(x, "Q").Value = "Sale" Then
If Cells(x, "D").Value = "1" Then
For i = 1 To 1000
If Cells(x - i, "R").Value <> "1" Then
'
Else
Range("G" & x).FormulaR1C1 = "=R[-" & i & "]C/R[-" & i & "]C[-1]*RC[-1]"
End If
Next i
End If
End If
Next x
End Sub
One of our spreadsheets requires a userform. When trying to paste the user's values to the sheet housing the data, I get error code 13: type mismatch.
All the fields are textboxes. One line of code identical except the address of where we're posting the information works.
Here's what I have:
Public Sub btnSubmit_Click()
Dim TableSht As Worksheet
Dim NextRow As Long
Set TableSht = ThisWorkbook.Sheets("Table")
TableSht.Visible = True
'https://www.mrexcel.com/forum/excel-questions/1017033-making-all-fields-userform-mandatory.html#post4880848
'determine if any fields were left blank
For Each Control In Me.Controls '
Select Case TypeName(Control)
Case "TextBox"
If Control.Value = vbNullString Then
MsgBox "empty field in " & Control.Name
Exit For
End If
Case Else
End Select
Next Control
'data is housed in E3:J3, E5:J5, E7:J7, E9:J9. if statement determines what row information
'should be entered on.
If TableSht.Range("E3") = "" Then
NextRow = 3
ElseIf TableSht.Range("E5") = "" Then
NextRow = 5
ElseIf TableSht.Range("E7") = "" Then
NextRow = 7
ElseIf TableSht.Range("E9") = "" Then
NextRow = 9
Else
MsgBox ("There are no more available rows. Contact Craig for additional assistance.")
End If
'paste the user's data entry into the appropriate cells
With TableSht
.Cells(NextRow, 5) = Me.tbOwner
.Cells(NextRow, 6) = CDate(Me.tbDate)
.Cells(NextRow, 7) = Me.tbChange
'Me.tbChange.Value = CDec(Me.tbChange) 'no longer use this but one of my attempts
.Cells(NextRow, 8) = Me.tbAmount
.Cells(NextRow, 9) = Me.tbOriginal
.Cells(NextRow, 10) = Me.tbReason
.Cells(NextRow, 7).Value = Format(Range("G" & NextRow) / 100, "0.00%")
.Cells(NextRow, 8).Value = Format(Range("H" & NextRow), "$##.##")
.Cells(NextRow, 9).Value = Format(Range("I" & NextRow) / 100, "0.00%")
End With
Sheets("Rate Calculator v8").Select
TableSht.Visible = xlVeryHidden
Unload Me
End
End Sub
The error occurs on
.Cells(NextRow, 7).Value = Format(Range("G" & NextRow) / 100, "0.00%")
There's no error if I remove the line and cycle through the two after it, even though the last line before "end with" is essentially the same statement.
I've tried swapping the two lines of code that are similar. "Cells(NextRow, 7)..." and ".Cells(NextRow, 9)..." but the error still shows up on the "Cells(NextRow, 7)..." line.
I've confirmed the cells the data is pasted in columns G and I are both formatted as "percentage".
Qualify your Range usage with a sheet. If the sheet is also TableSht, the below should work. If the Range is from a different sheet, qualify that sheet
= Format(.Range("G" & NextRow) / 100, "0.00%")
= Format(.Range("H" & NextRow), "$##.##")
= Format(.Range("I" & NextRow) / 100, "0.00%")
I have a big table in excel, which contains about 8000 rows of data. I am working on a procedure to enable the users to receive a pdf copy of what they are looking for. (A detail list related to a work order).
I tried two different approaches, first copying the work order items after filtering it to a third sheet and then copying selected fields of data to the final form. It was good and fast.
second, after filter directly copying data of unhidden rows to the final form. (also more sort and remove duplicated items happen too)
The second one is very time killing (3 to 5 minutes) and very heavy.
Now, I am thinking of first sorting the data in a way that my desired item (what the user is looking for) comes to the first of table so after the filter, I just ask the loop to go until a visible number of rows, not until the end of rows.
Has anyone any idea, or better solution?
Cheers and merry Christmas!
Sub kit_Click()
' On Error GoTo Errorhandler
Dim wc As String
Dim c As Integer
Dim tbl As Range
Dim sel As Range
Dim des As Range
Dim m As Integer
Dim j As Integer
Dim aggrow As Integer
Dim varResult As Variant
Dim kf As Worksheet
Set kf = Worksheets("Kit Form")
a = ""
' Application.ScreenUpdating = False
' finding W/B code to prepare
If Not Intersect(ActiveCell, Range("d2:d3")) Is Nothing Then
a = Cells(2, 7).Value
GoTo body
ElseIf ActiveCell.Row < 6 Then a = InputBox("please specify the W/B you want to prepare KIT form for that", "W/B Number")
ElseIf ActiveCell.Row > ActiveSheet.UsedRange.Rows.Count Then a = InputBox("please specify the W/B you want to prepare KIT form for that", "W/B Number")
Else: a = Cells(ActiveCell.Row, 2).Value
End If
body:
On Error GoTo skip
wc = WorksheetFunction.VLookup(a, Range("b5:c1000"), 2, 0)
skip:
If a = "" Or a = "0" Then
a = InputBox("please specify the W/B you want to prepare KIT form for that", "W/B Number")
Else
' Cleaning KIT FORM
If Not kf.ListObjects("KitForm").DataBodyRange Is Nothing Then kf.ListObjects("KitForm").DataBodyRange.EntireRow.Delete
' Filtering the W/B Kittable items
With Sheets("FTV3")
.Range("tbl").AutoFilter Field:=3, Criteria1:="*" & a & "*", Operator:=xlFilterValues
.Range("tbl").AutoFilter Field:=25, Criteria1:="OK", Operator:=xlFilterValues
' Unhidding the Columns and copying the header row
.Cells.EntireColumn.Hidden = False
' Copying the data to Form
lstrw = .Cells(Rows.Count, 8).End(xlUp).Row
kf.Cells(2, 2) = a
kf.Cells(1, 4) = wc
m = 1
For i = 2 To lstrw
If .Rows(i).EntireRow.Hidden Then
m = m + 1
Else
kf.Rows(i - m + 4).RowHeight = 25
kf.Cells(i - m + 4, 1).Value = i - m
If .Cells(i, 21).Value = "_N/A" Then
kf.Cells(i - m + 4, 2) = "'"
Else
kf.Cells(i - m + 4, 2) = .Cells(i, 21)
End If
kf.Cells(i - m + 4, 3).Value = .Cells(i, 4).Value
If .Cells(i, 4).Value <> "_Book" Then kf.Cells(i - m + 4, 4).Value = .Cells(i, 26).Value
Worksheets("Kit Form").Cells(i - m + 4, 5).Value = .Cells(i, 7).Value
If .Cells(i, 8).Value <> "N/T" Then kf.Cells(i - m + 4, 6).Value = .Cells(i, 8).Value
If .Cells(i, 12).Value <> "_N/A" Then ttt = .Cells(i, 12) 'Or .Cells(i, 22).Value <> ""
kf.Cells(i - m + 4, 7).Value = "(( " & .Cells(i, 27).Value & " ))" & Chr(10) & ttt
kf.Rows(i - m + 4).AutoFit
If kf.Rows(i - m + 4).RowHeight < 25 Then kf.Rows(i - m + 4).RowHeight = 25
End If
Next
.Range("A:B,S:ac").EntireColumn.Hidden = True
aggrow = kf.Cells(Rows.Count, 1).End(xlUp).Row - 4
.Range("tbl").AutoFilter
End With
Call remove_duplicate
R = MsgBox("Successfuly Total of " & lstrw - m - 1 & " Items, aggregated in " & aggrow & " Rows of material Copied to the Kit Form " & Chr(10) & Chr(10) & "Do you want an PDF version of The form being prepared for you?", vbYesNo, "Result")
If R = 6 Then Call export_pdf
End If
End Sub
I have some excel data that comes from a lab in a strange format and am trying to figure out how to put all of the patient data on the same line. An example is below, with a single entry highlighted in red so you can see that the whole thing spans 3 lines:
I think a macro would work well for something like this but recording macros is the extent of my knowledge. I do not really know how to write VBA. The goal is to get all patient information on the same row so that they can be filtered (example below):
What I have done to figure this out on my own: I began recording a macro and manually changing things (for the recording) when I realized that the references might change depending on the heading of the worksheet, which changes. I could do a relative reference macro but then pointing the cursor to the right spot for each patient over and over is almost as much work as doing it by hand. It seemed like there should be a way to say "everything contained in three lines is one 'entry', so put on one line, starting here and ending there" or something?
How's this:
Sub text()
Dim lastRow As Integer, ageCol As Integer, addressCol As Integer, i As Integer, endRow As Integer
Dim startRow As Integer, phoneCol As Integer
lastRow = ActiveSheet.UsedRange.Rows.Count
ageCol = Rows(1).Find(what:="DOB_Age").Column
addressCol = Rows(1).Find(what:="Address").Column
phoneCol = Rows(1).Find(what:="Phone").Column
'Starting off, go to first name in the list.
startRow = Cells(1, 1).End(xlDown).Row
endRow = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
For i = startRow To endRow
Cells(i, 1).Select
If Cells(i, 1).Value <> "" Then
Cells(i, ageCol).Value = Cells(i, ageCol).Value & " " & Cells(i, ageCol).Offset(1, 0).Value
Cells(i, addressCol).Value = Cells(i, addressCol).Offset(-1, 0).Value & ", " & Cells(i, addressCol).Value & ", " & Cells(i, addressCol).Offset(1, 0).Value
Cells(i, phoneCol).Value = Cells(i, phoneCol).Offset(1, 0).Value
' Now, let's clear the data we copied over.
Cells(i, ageCol).Offset(1, 0).Value = ""
Cells(i, addressCol).Offset(-1, 0).Value = ""
Cells(i, addressCol).Offset(1, 0).Value = ""
Cells(i, phoneCol).Offset(1, 0).Value = ""
End If
Next i
'Now, let's delete all the empty rows
For i = 1 To endRow
If i > endRow Then Exit For
If IsEmpty(Cells(i, 1)) Then
Cells(i, 1).EntireRow.Delete
i = i - 1
endRow = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
End If
Next i
End Sub
Note: This assumes that your data will always look like your question - the row with a name on it has ONE row above and ONE row below that need to be moved to the name's row. Please let me know what works/what doesn't work and needs tweaking. Good luck!
Multiple Formula (Non-VBA) Solution:
This option would be to get the values to appear in another sheet using formulas and autofilling down.
Note: this option assumes that all your data is as shown in the images, currently I do not account for any exceptions (which can be added)
Here are the formulas (using "Sheet1" as the reference sheet, change that to whatever your sheet name is):
(Horizontal view, ..have fun scrolling..)
A B C D E F
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
1| Id Patient_Name Sex DOB_Age Address Phone
2| =INDIRECT("Sheet1!A"&(ROW()-1)*3) =INDIRECT("Sheet1!B"&(ROW()-1)*3) =INDIRECT("Sheet1!C"&(ROW()-1)*3) =TEXT(INDIRECT("Sheet1!D"&(ROW()-1)*3),"m/d/yyy")&", "&INDIRECT("Sheet1!D"&(ROW()-1)*3+1) =INDIRECT("Sheet1!E"&(ROW()-1)*3-1)&", "&INDIRECT("Sheet1!E"&(ROW()-1)*3)&", "&INDIRECT("Sheet1!E"&(ROW()-1)*3+1) =INDIRECT("Sheet1!F"&(ROW()-1)*3+1)
3| ..Autofill down..
(Vertical view)
Id
=INDIRECT("Sheet1!A"&(ROW()-1)*3)
Patient_Name
=INDIRECT("Sheet1!B"&(ROW()-1)*3)
Sex
=INDIRECT("Sheet1!C"&(ROW()-1)*3)
DOB_Age
=TEXT(INDIRECT("Sheet1!D"&(ROW()-1)*3),"m/d/yyy")&", "&INDIRECT("Sheet1!D"&(ROW()-1)*3+1)
Address
=INDIRECT("Sheet1!E"&(ROW()-1)*3-1)&", "&INDIRECT("Sheet1!E"&(ROW()-1)*3)&", "&INDIRECT("Sheet1!E"&(ROW()-1)*3+1)
Phone
=INDIRECT("Sheet1!F"&(ROW()-1)*3+1)
Now since these are formulas and not vba, the data will automatically change if the source changes. So if you want to only keep the values you can copy -> paste special -> values on a new sheet to keep only the values
Sub Parse_Data()
Dim rngTarget As Range, x As Long
Set rngTarget = Worksheets("Target").Range("A2")
For x = 2 To Range("E1").Offset(Rows.Count - 1).End(xlUp).Row
Select Case x Mod 3
Case 2
rngTarget.Offset(, 5).Value = Range("A1").Offset(x - 1, 4).Value
Case 0
rngTarget.Offset(, 0).Value = Range("A1").Offset(x - 1, 0).Value
rngTarget.Offset(, 1).Value = Range("A1").Offset(x - 1, 1).Value
rngTarget.Offset(, 2).Value = Range("A1").Offset(x - 1, 2).Value
rngTarget.Offset(, 3).Value = Range("A1").Offset(x - 1, 3).Value
rngTarget.Offset(, 6).Value = Range("A1").Offset(x - 1, 4).Value
Case 1
rngTarget.Offset(, 4).Value = Range("A1").Offset(x - 1, 3).Value
rngTarget.Offset(, 7).Value = Range("A1").Offset(x - 1, 4).Value
rngTarget.Offset(, 8).Value = Range("A1").Offset(x - 1, 5).Value
Set rngTarget = rngTarget.Offset(1)
End Select
Next x
End Sub
I have a userform and I want to check if a particular giftcard is present in the database or not and if found I would like to pull the values into the relevant textboxes.
I'm using the code below. This code checks for a valid gift-card (this part works).
iRow is the Last row in database
ValueToFind is the ID of gift-card
WithType is the Type of gift-card.
Code:
For i = 1 To iRow + 1
If ws.Cells(i, 2).Value = ValueToFind And _
ws.Cells(i, 1).Value = WithType And _
ws.Cells(i, 6).Value = "" Then
...
Exit Sub
End If
Next i
But I can't find a way to update the Me.TXT_MONEY.Value and Me.TXT_DATE.Value in the userform textboxes.
Can you help me with this code?
Is this what you are trying?
For i = 1 To iRow + 1
If ws.Cells(i, 2).Value = ValueToFind And _
ws.Cells(i, 1).Value = WithType And _
ws.Cells(i, 6).Value = "" Then
TXT_MONEY.Value = ws.Cells(i, X).Value
TXT_DATE.Value = ws.Cells(i, Y).Value
Exit Sub
End If
Next i
Replace X and Y in the above code with the relevant column number from where you want to pick up values.
Also instead of looping, you may actually want to use .Find? See THIS link from my blog.