Hello I have the following problem:
As you can see in column A we have Dates, in column B there is always a "1" when a year changes from one to the next, I marked it in yellow. In column H are different values and in column I, I want to have only the FIRST value, which is greater (in this case) than 10% within one year (so in the period from one to one in column B). After that I want to have the next first value, which is >10% in the next year so next period from 1 to 1 in column B and so on.
Can anyone help me?
So far I programmed this, but it shows me all values >10% but not the first from each range to each range.
Sub ABC ()
With ThisWorkbook.Worksheets("Test")
rowCount = 2
Do While .Cells(rowCount + 1, 8).Value <> ""
If .Cells(rowCount, 2).Value = 0 And .Cells(rowCount, 8).Value >= 0.1 Then
.Cells(rowCount, 9).Value = .Cells(rowCount, 7).Value * 0.1 / 1.1
Else
.Cells(rowCount, 9).Value = ""
End If
rowCount = rowCount + 1
Loop
End With
End Sub
It seem the code is error on the cell address
Sub ABC ()
With ThisWorkbook.Worksheets("Test")
rowCount = 2
Do While .Cells(rowCount + 1, 8).Value <> ""
If .Cells(rowCount, 2).Value = 0 And .Cells(rowCount, 8).Value >= 0.1 Then
.Cells(rowCount, 9).Value = .Cells(rowCount, 8).Value * 0.1 / 1.1
Else
.Cells(rowCount, 9).Value = ""
End If
rowCount = rowCount + 1
Loop
End With
End Sub
Related
I am trying to edit my excel table with VBA but an error appears while compiling. It doesnt recognize line 2 and line 10.
Sub IfThenElse()
Dim i As Integer = 23
While Not IsNull(Cells(i, 35).Value)
If Cells(i, 35).Value > 1E+16 Then
Cells(i, 4).Value = Cells(i, 35).Value / 10
Else
Cells(i, 4).Value = Cells(i, 35).Value
i = i + 1
End If
End While
End Sub
You cannot declare a variable and set a value at the same time Dim i As Integer = 23
Row counts are of type Long not Integer, Excel has more rows than Integer can handle.
Dim i As Long
i = 23
While … End While is no valid syntax, you need to use Do While … Loop (see Do...Loop statement).
It is very unlikely that a cell value is Null if you are looking for an empty cell use IsEmpty or check for vbNullString
Do While Not IsEmpty(Cells(i, 35).Value) 'or Do While Not Cells(i, 35).Value = vbNullString
If Cells(i, 35).Value > 1E+16 Then
Cells(i, 4).Value = Cells(i, 35).Value / 10
Else
Cells(i, 4).Value = Cells(i, 35).Value
i = i + 1
End If
Loop
Not sure what exactly you are doing but i = i + 1 might need to come after End If.
I just can't seem to get this for loop running correctly. I know that I missing something basic, but I just can't figure it.
I have 2 tables.
Table 1 : (Table starts at row 7, and columns i to q are hidden)
Table 2 :
My goal is to pull new rows from Table1 to Table2.
My code rolls through Table 1, identifies the rows with an 'R' value, and fills them.
Then I want to pull data from those same rows to Table2
The code that identifies and fills the 'R' value:
Dim iRow As Long
With Sheet12
iRow = Application.Count(.ListObjects("Table1").ListColumns("KEY").DataBodyRange)
End With
'find last row with a date
Dim jRow As Long
With Sheet12
jRow = Application.Count(.ListObjects("Table1").ListColumns("Date").DataBodyRange)
End With
'take the value from iRow and col 1, add 1, place in iRow+1,1
Dim q As Long
For q = iRow + 7 To jRow + 6
Sheet12.Cells(q, 18) = 1 + Sheet12.Cells(q - 1, 18)
Next q
Then this bit I'm having trouble with. My thought was try to run a double loop, where I loop through to fill each column and then each row.
Dim a As Long
Dim b As Long
Dim c As Long
c = jRow - iRow
For b = 11 To c + 11
For a = iRow + 7 To jRow + 6
ws15.Cells(b, 1).Value = "Plaid-" & Sheet12.Cells(a, 8).Value & "-" & Sheet12.Cells(a, 7).Value
ws15.Cells(b, 2).Value = Sheet12.Cells(a, 18).Value
ws15.Cells(b, 3).Value = Sheet12.Cells(a, 3).Value
ws15.Cells(b, 4).Value = Sheet12.Cells(a, 4).Value
ws15.Cells(b, 5).Value = Sheet12.Cells(a, 5).Value
ws15.Cells(b, 6).Value = 1001
ws15.Cells(b, 7).Value = "FILL IN"
Next a
Next b
Now the above code only copies the last row from Table1 into Table2 four times.
I know I'm close, and I'm sure I'm just tired, but I can't get it right. I appreciate everyone's time.
The double loop is causing the problem. The inside loop fills in the same row 4 times. This explains why every row has the same data.
You want to iterate the rows together so you just need 1 loop. The b variable is not needed.
Try this code:
Dim a As Long
Dim c As Long
c = jRow - iRow + 7 'start row on new sheet
For a = iRow + 7 To jRow + 6 'source data rows
ws15.Cells(c, 1).Value = "Plaid-" & Sheet12.Cells(a, 8).Value & "-" & Sheet12.Cells(a, 7).Value
ws15.Cells(c, 2).Value = Sheet12.Cells(a, 18).Value
ws15.Cells(c, 3).Value = Sheet12.Cells(a, 3).Value
ws15.Cells(c, 4).Value = Sheet12.Cells(a, 4).Value
ws15.Cells(c, 5).Value = Sheet12.Cells(a, 5).Value
ws15.Cells(c, 6).Value = 1001
ws15.Cells(c, 7).Value = "FILL IN"
c = c + 1 'next row on new sheet
Next a
I am writing a user-form to input data into an excel spreadsheet and i am having issues with the counta command to register a blank line.
I am new to VBA and tried looking for alternatives online without much success, and honestly not knowing what i was looking at when reading some of the code.
Please see my code below and for some context it is for room management, tracking guests arrival and departure dates, room rates and if two rooms are utilized next to each other. For some reason the data input begins at row 25 and i can't figure out for the life of me why when there are 25 blank rows above the cell being registered:
Dim emptyRow As Long
emptyRow = Application.WorksheetFunction.CountA(Range("B:B")) + 1
Cells(emptyRow, 2).Value = txtRoomNum.Value
Cells(emptyRow, 3).Value = txtGuestName.Value
Cells(emptyRow, 4).Value = DTPicker1.Value
Cells(emptyRow, 5).Value = DTPicker2.Value
If opInter.Value = True Then
Cells(emptyRow, 7).Value = (Val(txtRev1.Text) + Val(txtRev2.Text) + Val(txtRev3.Text)) * 0.5
Cells(emptyRow, 12).Value = Val(txtChildren.Text) * 0.5
Cells(emptyRow, 13).Value = Val(txtAdults.Text) * 0.5
Else
Cells(emptyRow, 7).Value = (Val(txtRev1.Text) + Val(txtRev2.Text) + Val(txtRev3.Text))
Cells(emptyRow, 12).Value = txtChildren.Value
Cells(emptyRow, 13).Value = txtAdults.Value
End If
Cells(emptyRow, 8).Value = UCase(txtRateCode.Value)
If opRoomOnly.Value = True Then
Cells(emptyRow, 10).Value = "Yes"
Else
Cells(emptyRow, 10).Value = "No"
End If
If opInter = True Then
Cells(emptyRow, 11).Value = "Yes"
Else
Cells(emptyRow, 11).Value = "No"
End If
Unload Me
End Sub```
The function COUNTA() returns the number of cells that are not blank in a given range.
I assume you want to paste data on the first empty row in the sheet, so you need the number of the last non-empty row (+1) to paste the data in. Try this:
emptyRow = Cells(Rows.Count, "B").End(xlUp).Row + 1
Here are some more examples on how to find last row / column in a sheet.
https://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
I am using the following code to enter data from Userform to Excel sheet and works fine.
The problem is that it overwrites the same row of data. But if I change:
.Cells(RowCount, 4).Value = Me.DepSectDrop.Value to contain a 1 --> .Cells(RowCount, 1).Value = Me.DepSectDrop.Value, and likewise for the rest (2 fore SiteFacOpen, 3 for CaseStartOpen, etc), it does not overwrite.
Private Sub cmdAdd_Click()
'Copy input values to sheet.
Dim RowCount As Long
Dim ws As Worksheet
Set ws = Worksheets("TRACK")
RowCount = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Cells(RowCount, 4).Value = Me.DepSectDrop.Value
.Cells(RowCount, 5).Value = Me.SiteFacOpen.Value
.Cells(RowCount, 6).Value = Me.CaseStartOpen.Value
.Cells(RowCount, 7).Value = Me.TypeDrop.Value
.Cells(RowCount, 8).Value = Me.ProcessDrop.Value
.Cells(RowCount, 9).Value = Me.CompNameOpen.Value
.Cells(RowCount, 10).Value = Me.CompEIDOpen.Value
.Cells(RowCount, 11).Value = Me.RespNameOpen.Value
.Cells(RowCount, 12).Value = Me.RespEIDOpen.Value
.Cells(RowCount, 13).Value = Me.DescOpen.Value
End With
'Clear input controls.
Me.DepSectDrop.Value = ""
Me.SiteFacOpen.Value = ""
Me.CaseStartOpen.Value = ""
Me.TypeDrop.Value = ""
Me.ProcessDrop.Value = ""
Me.CompNameOpen.Value = ""
Me.CompEIDOpen.Value = ""
Me.RespNameOpen.Value = ""
Me.RespEIDOpen.Value = ""
Me.DescOpen.Value = ""
End Sub
What do I need to do to so I maintain the right columns for it all to be entered, but not be overwritten? Thank you
You need to change all lines that start
.Cells(RowCount, 5).Value ...
To
.Cells(RowCount + 1, 5).Value
The '+1' bit means you're using the next blank line.
Also, as Samuel pointed out, you should also change to
RowCount = ws.Cells (Rows.Count, 4).End (xlUp).Offset (1,0).Row
so that you're testing a column that's guaranteed to have data in it!
Sorry, I missed the offset bit ... No need to '+1' if you're offsetting by 1 ... It amounts to the same thing.
I am trying to write a code that will take one cell and then iterate through another column to find a match, once it has found a match it will then match two other cells in that same row and return the value of a 5th and 6th cell. However, it is not working! any suggestions??
Sub rates()
Dim i As Integer
For i = 2 To 2187
If Cells(i, 1).Value = Cells(i, 11).Value Then
If Cells(i, 2).Value = Cells(i, 12).Value Then
Cells(i, 20) = Cells(i, 1).Value
Cells(i, 21) = Cells(i, 11).Value
Cells(i, 22) = Cells(i, 4).Value
Cells(i, 23) = Cells(i, 16).Value
Else
Cells(i, 24) = "No match"
End If
End If
Next i
End Sub
Try fully qualifying your cell objects i.e. sheet1.cells(i,1).value etc or encase within a with statement i.e.
with sheet1
if .cells(i,X) = .cells(i,Y) then
'...etc
end with
I think the default property for a range is "Value" but try putting .Value on to the end of all those Cell lines too... like you have for half of them :)
[EDIT/Addition:]
... failing that, you're not actually searching a whole column at any point: try something like:
Sub rates()
Dim i As Integer
Dim rgSearch As Range
Dim rgMatch As Range
Dim stAddress As String
Dim blMatch As Boolean
With wsSheet
Set rgSearch = .Range(.Cells(x1, y1), .Cells(x2, y2)) ' Replace where appropriate (y = 1 or 11 i guess, x = start and end row)
End With
For i = 2 To 2187
Set rgMatch = rgSearch.Find(wsSheet.Cells(i, y)) ' y = 1 or 11 (opposite of above!)
blMatch = False
If Not rgMatch Is Nothing Then
stAddress = rgMatch.Address
Do Until rgMatch Is Nothing Or rgMatch.Address = stAddress
If rgMatch.Offset(0, y).Value = Cells(i, 12).Value Then
Cells(i, 20) = Cells(i, 1).Value
Cells(i, 21) = Cells(i, 11).Value
Cells(i, 22) = Cells(i, 4).Value
Cells(i, 23) = Cells(i, 16).Value
blMatch = True
Else
End If
Set rgMatch = rgSearch.FindNext(rgMatch)
Loop
End If
If Not blMatch Then
Cells(i, 24) = "No match"
End If
Next i
End Sub
I've made a lot of assumptions in there and there's a few variables you'll have to replace. You could also probably use application.worksheetfunction.match but .find is quicker and more awesome