this is my code and I want to re-execute it so that the next column has the exact same code repeated on it. That is, D:28 moves to E:28 and range E:110:I120 moves to F110:J120. I am having trouble finding a loop that does this, can anyone please help. My code is,
Sub Rebuild()
tonnes = Range("D28").Value
If tonnes > 2600000 Then
Range("E110:I120").Select
Selection.Copy
Range("E18:I28").Select
ActiveSheet.Paste
Else:
Range("E18:I28").Interior.Color = xlNone
Range("E18:I18") = ""
Range("E19:I19") = ""
Range("E20:I20") = 0
Range("E21:I21") = 2.4
Range("E22:I22") = "=E21+E20"
Range("E23:I23") = "=24 - E22"
Range("E24:I24") = "=100 * E23 / 24"
Range("E25:I25") = 3000
Range("E26:I26") = "=E25 * E23"
Range("E27:I27") = "=E26"
Range("E28:I28") = "=D28 + 27"
End If
End Sub
Option Explicit
Sub Rebuild()
Dim cumtonnes As Long
'you initially had tonnes as the variable name, but I was not sure if this was a typo or not.
cumtonnes = Range("D28").Value
If cumtonnes > 2600000 Then
Range("E110:I120").Copy Range("F110:J120")
Range("D28").Copy Range("E28")
Else:
Range("E18:I28").Interior.Color = xlNone
Range("E18:I18") = ""
Range("E19:I19") = ""
Range("E20:I20") = 0
Range("E21:I21") = 2.4
Range("E22:I22") = "=E21+E20"
Range("E23:I23") = "=24 - E22"
Range("E24:I24") = "=100 * E23 / 24"
Range("E25:I25") = 3000
Range("E26:I26") = "=E25 * E23"
Range("E27:I27") = "=E26"
Range("E28:I28") = "=D28 + 27"
End If
End Sub
So I adjusted the part that will do the copy and paste of the cells. I did not add in any loop currently as I did not know what you wanted repeated 30 times.
Related
I'm trying to check if the column headers are in their right positions ( I have declared the actual column headers as constant values) and if they are not move them around to their right positions.
I'm new to VBA and when I tried it out with the basic For loop and Select Case, I realised the code was too long. I was thinking if there is another perhaps a simpler way to do it.
Below is a sample of the code I tried:
Sheet4_Last_RowNum = WorkingSheet.Cells(Rows.Count, 1).End(xlUp).Row
Sheet4_Last_ColNum = WorkingSheet.Cells(Label_RowNum, Columns.Count).End(xlToLeft).Column
For icol = 1 To Sheet4_Last_ColNum
Select Case WorkingSheet.Cells(Label_RowNum, icol).Value
Case "WkVersion"
Sheet4_WkCol = icol
If Sheet4_WkCol <> Sheet4_ActualWk Then
Sheet4_WkValue = WorkingSheet.Range(Cells(headerRow, Sheet4_WkCol), Cells(Sheet4_Last_RowNum, Sheet4_WkCol))
End If
Case "MPA"
Sheet4_MPACol = icol
If Sheet4_MPACol <> Sheet4_ActualMPA Then
Sheet4_MPAValue = WorkingSheet.Range(Cells(headerRow, Sheet4_MPACol), Cells(Sheet4_Last_RowNum, Sheet4_MPACol))
End If
Case "Location"
Sheet4_LocCol = icol
If Sheet4_LocCol <> Sheet4_ActualLoc Then
Sheet4_LocValue = WorkingSheet.Range(Cells(headerRow, Sheet4_LocCol), Cells(Sheet4_Last_RowNum, Sheet4_LocCol))
End If
End Select
Next icol
With WorkingSheet
If IsEmpty(Sheet4_WkValue) = True Then
Else
.Range(Cells(headerRow, Sheet4_ActualWk), Cells(Sheet4_Last_RowNum, Sheet4_ActualWk)) = Sheet4_WkValue
End If
If IsEmpty(Sheet4_MPAValue) = True Then
Else
.Range(Cells(headerRow, Sheet4_ActualMPA), Cells(Sheet4_Last_RowNum, Sheet4_ActualMPA)) = Sheet4_MPAValue
End If
If IsEmpty(Sheet4_LocValue) = True Then
Else
.Range(Cells(headerRow, Sheet4_ActualLoc), Cells(Sheet4_Last_RowNum, Sheet4_ActualLoc)) = Sheet4_LocValue
End If
End With
The attached code is run on VBA, but I do not understand why there is an error says else without if or if without end if. I am pretty sure that I have matched every end if with if statement.
Sub teee() is just for testing the decimalize function. It would be greatly check the code and tell me what is wrong with my code... I am almost close to complete a project if I can troubleshoot this function.
Sub teee()
sss = "-1-21+"
MsgBox (decimalize(sss))
End Sub
Function decimalize(s As Variant) As Long
Dim checkers As Variant
Dim ab As Long
Dim leftnum As Long
Dim rightnum As Long
Dim poneg As Integer
checkers = s
ab = 0
leftnum = 0
rigntnum = 0
poneg = 0
'Positive payup or negative payup
If Left(checkers, 1) = "-" Then
poneg = 1
lencheckers = Len(checkers)
checkers = Mid(checkers, 2, lencheckers - 1)
Else: poneg = 0
End If
startp = InStr(checkers, "-")
If startp = 2 Then leftnum = Left(checkers, 1)
ElseIf startp = 3 Then leftnum = Left(checkers, 2)
ElseIf startp = 4 Then leftnum = Left(checkers, 3)
End If
rightnum = Mid(checkers, startp + 1, 2)
If InStr(checkers, "+") > 0 Then
ab = 0.5
ElseIf InStr(checkers, "1/4") > 0 Then
ab = 0.25
ElseIf InStr(checkers, "1/8") > 0 Then
ab = 0.125
End If
rightnum = rightnum + ab
If poneg = 0 Then
decimalize = rightnum + leftnum * 32
ElseIf poneg = 1 Then
decimalize = (rightnum + leftnum * 32) * -1
End If
End Function
Many Thanks in advance
#Vityata showed one way to eliminate that particular bug. Another way is to avoid If altogether and use a Select Case. The resulting code is somewhat more readable:
Select Case startp
Case 2: leftnum = Left(checkers, 1)
Case 3: leftnum = Left(checkers, 2)
Case 4: leftnum = Left(checkers, 3)
End Select
Also, You have an arbitrary pattern of declaring some variables but not others, and you have at least one variable typo: rigntnum = 0 should almost certainly be rightnum = 0. You really need to use Option Explicitat the top of all of your modules (also, enable Require Variable Declaration in the VBA editor options). That will help you write code that isn't prone to random bugs.
Change it like this:
If startp = 2 Then
leftnum = Left(checkers, 1)
ElseIf startp = 3 Then leftnum = Left(checkers, 2)
ElseIf startp = 4 Then leftnum = Left(checkers, 3)
End If
Info: When you write the result after the "then" on the same line, should not write end if. Thus, VBA does not understand where the next ElseIf is coming from.
Pretty much you are allowed to use the following two examples:
'Example 1 (no end if here)
if startp = 2 then leftnum = Left(checkers,1)
'Example 2 (you need end if here)
if startp = 2 then
leftnum = Left(checkers,1)
end if
I am currently programming a sheet which visualizes data sets in graphs. Because the user of this sheet will not need all the graphs, I would like to let them choose the ones needed through a UserForm. Since the amount of data sets is variable, the UserForm will have the same amount of checkboxes as there are datasets.
The Userform code is as follows.
Private Sub UserForm_Initialize()
Dim chkBoxA As MSForms.CheckBox
Dim chkBoxB As MSForms.CheckBox
Dim lblBox As MSForms.Label
Dim cnt As Control
Amount = Sheet4.Range("C4").Value 'Amount of datasets
For i = 1 To Amount
Set lblBox = Me.Controls.Add("Forms.label.1", "Label" & i)
lblBox.Caption = "Set" & i
lblBox.Left = 5
lblBox.Top = 8 + ((i - 1) * 40)
Set chkBoxA = Me.Controls.Add("Forms.CheckBox.1", "A" & i)
chkBoxA.Caption = "Graph a"
chkBoxA.Left = 55
chkBoxA.Top = 5 + ((i - 1) * 40)
Set chkBoxB = Me.Controls.Add("Forms.CheckBox.1", "B" & i)
chkBoxB.Caption = "Graph b"
chkBoxB.Left = 55
chkBoxB.Top = 20 + ((i - 1) * 40)
Next
CommandButton1.Left = 20
CommandButton1.Top = 40 + ((Amount - 1) * 40)
CommandButton1.TabIndex = Amount * 3 + 1
Me.Height = 220
Me.ScrollBars = fmScrollBarsVertical
Me.ScrollWidth = Me.InsideWidth * 9
For Each cnt In Me.Controls
If cnt.Top + cnt.Height > Me.ScrollHeight Then
Me.ScrollHeight = cnt.Top + cnt.Height + 5
End If
Next
End Sub
When the UserForm is filled in (graphs are chosen by clicking on the options), the user will press CommandButton1. An event should then be run to show the correct graph, but for the simplicity I am first testing if a MsgBox will show up. Unfortunately the MsgBox does not show up.
Private Sub CommandButton1_Click()
'Will fix this with a loop
If A1 = True Then
MsgBox ("TestA1")
End If
If B1 = True then
MsgBox ("TestB1")
End If
If A2 = True then
MsgBox ("TestA2")
End If
Unload Me
End Sub
I am stuck on this part. The checkboxes do show up on the UserForm and they are clickable, but the commandbutton only shuts down the sub (Unload Me). I would like to see the MsgBox show up when I select the corresponding option and click the commandbutton. Any help on getting this to work is appreciated!
You are referencing 'A1' in the sub, but that variable does not exitst at compile time, because you add them dynamically. What you need to do is loop the controls, to check the names. Best practice is to put the checkboxes in a frame, to be able to group them.
Add a frame to the userform and name it 'checkboxframe'
And then instead of:
For i = 1 To Amount
Set lblBox = Me.Controls.Add("Forms.label.1", "Label" & i)
lblBox.Caption = "Set" & i
lblBox.Left = 5
lblBox.Top = 8 + ((i - 1) * 40)
Set chkBoxA = Me.Controls.Add("Forms.CheckBox.1", "A" & i)
chkBoxA.Caption = "Graph a"
chkBoxA.Left = 55
chkBoxA.Top = 5 + ((i - 1) * 40)
Set chkBoxB = Me.Controls.Add("Forms.CheckBox.1", "B" & i)
chkBoxB.Caption = "Graph b"
chkBoxB.Left = 55
chkBoxB.Top = 20 + ((i - 1) * 40)
Next
you would need to do:
With Me.checkboxframe
For i = 1 To Amount
Set lblBox = .Controls.Add("Forms.label.1", "Label" & i)
lblBox.Caption = "Set" & i
lblBox.Left = 5
lblBox.Top = 8 + ((i - 1) * 40)
Set chkBoxA = .Controls.Add("Forms.CheckBox.1", "A" & i)
chkBoxA.Caption = "Graph a"
chkBoxA.Left = 55
chkBoxA.Top = 5 + ((i - 1) * 40)
Set chkBoxB = .Controls.Add("Forms.CheckBox.1", "B" & i)
chkBoxB.Caption = "Graph b"
chkBoxB.Left = 55
chkBoxB.Top = 20 + ((i - 1) * 40)
Next
End With
And to add the checkboxes to the frame, use something like:
For Each ctr In UserForm1.frame("checkboxframe").Controls
If TypeName(ctr) = "CheckBox" Then
If ctr.Value = True Then
'do something usefull here
msgbox ctr.name
End If
End If
Next ctr
The reason nothing appears is because there is no object "A1" manually defined as a variable.
To get the value of the box you Dynamically named "A1" you would have to refer to it as such:
If Me.Controls.Item("A1").Value = True then
Hope this helps!
This is my first time coding from scratch and a very dumb question indeed.
Why do i keep getting this error?
Runtime Error '13' : Type mismatch
My value in B1 is an integer
Private Sub Workbook_Open()
xdate = Worksheets("sheet1").Range("A1")
lsdate = DateAdd("d", -7, Date)
'MsgBox lsdate
If Day(lsdate) > Day(xdate) Then
Worksheets("sheet1").Range ("B1") * 1 = result
Else
Worksheets("sheet1").Range ("B1") * 1.07 = result
End If
Range("c1").Value = result
End Sub
I have further edit my code to the following but not able to get the condition to work
'To create the following condition
'If less than 7 days interest = 0%
'if 8 to 30 days interest = 7%
'if more than 31 days interest = 9%
Sub Workbook_Open()
For i = 1 To 3 'Rows.Count
xdate = Cells(i, 1)
'MsgBox Cells(i, 1)
nulldate = DateAdd("d", -7, Date)
irate7late = DateAdd("d", -8, Date)
irate7early = DateAdd("d", -30, Date)
If Day(nulldate) < Day(xdate) Then
result = Cells(i, 2) * 1
ElseIf Day(irate7early) <= Day(xdate) And Day(xdate) <= Day(irate7late) Then
'30/9/2015 20/10/2015 20/10/2015 22/10/2015
result = Cells(i, 2) * 1.07
ElseIf Day(irate7early) > Day(xdate) Then
result = Cells(i, 2) * 1.09
End If
Cells(i, 3).Value = result
Next i
End Sub
You seem pretty new at programming, so I'll explain plainly :
When you are trying to assign a value to a variable in almost every language, you use :
variable = value
So you can do a lot of operations on the value, which is on the right of the equals =.
BUT you canNOT do operations on the left of the equals = when you simply assigning a value to a variable. You can do almost any operations when you are testing 2 variables but you'll have a keyword like If or While at the start of the line of code.
So the issue with your code is that you reversed the order of the value and the variable and tried to do value * 1 = variable
Here is your corrected code (I indented it so that it can be read easily) :
Private Sub Workbook_Open()
xdate = Worksheets("sheet1").Range("A1")
lsdate = DateAdd("d", -7, Date)
'MsgBox lsdate
If Day(lsdate) > Day(xdate) Then
result = Worksheets("sheet1").Range ("B1") * 1
Else
result = Worksheets("sheet1").Range ("B1") * 1.07
End If
Sheets("Sheet_name").Range("c1").Value = result
End Sub
And you should always reference the sheet you are working with, because previously, your code didn't specify on which sheet the C1 was supposed to be.
So here, just change Sheet_name to whatever the name of your sheet is!
variables need to get the values from sheet. You are trying opposite way which is why you getting error.
Private Sub Workbook_Open()
xdate = Worksheets("sheet1").Range("A1")
lsdate = DateAdd("d", -7, Date)
'MsgBox lsdate
If Day(lsdate) > Day(xdate) Then
result = Worksheets("sheet1").Range("B1") * 1
Else
result = Worksheets("sheet1").Range("B1") * 1.07
End If
Range("c1").Value = result
End Sub
Sub test1()
Dim var1 As Variant
' If you need to get values from the range("D1") Then use the below code
var1 = Worksheets("sheet1").Range("D1").Value
End Sub
I am trying to set up a personal management spreadsheet for work. I have a list of tasks with varying priority.
What I am trying to do here is if the number of tasks * priority goes hits certain thresholds the colour of the availability cells changes and the description cell value changes, eg "busy"
here is the code I have so far, how do I implement it to change automatically when I change the value of the task list
Sub Avail_flag()
TasksRange = ActiveSheet.Range("P3:P6")
availcells = Range("M8,N8")
busyflag = 0
medBusyFlag = 0
highBusyFlag = 0
imedBusyFlag = 0
If Range("p4") > 0 Then
medBusyFlag = 1
ElseIf Range("p4") > 2 Then
medBusyFlag = 2
ElseIf Range("p5") > 0 Then
highBusyFlag = 1
ElseIf Range("p5") > 2 Then
highBusyFlag = 2
ElseIf Range("p6") > 0 Then
imedBusyFlag = 1
End If
For Each sell In lRange
busyflag = (medBusyFlag + (highBusyFlagI * 2) + (imedBusyFlag * 3))
If busyflag > 0 Then
For Each cell In Range(availcells)
cell.Color = green
Next
cell("N8").Value = "Occupied"
ElseIf busyflag > 3 Then
For Each cell In Range(availcells)
cell.Color = orange
Next
cell("N8").Value = "Busy"
ElseIf busyflag > 5 Then
For Each cell In Range(availcells)
cell.Color = red
Next
cell("N8").Value = "Unavailable"
Else
For Each cell In Range(availcells)
cell.Color = white
End If
End Sub
here is a capture of the spreadsheet if that helps, the highlighted grey part is where all the magic happens
You can use the Change event for the sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
I went for conditional formatting, something I hadn't heard of before. After looking it up and learning how to use it it seem to be by far the best option. Thank you #mehow for the usggestion