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
Related
Can you give me a hint on how to make such code more elegant?
I need some more of these queries in the future and I would like to do it more professionally.
Thank you!
If Case = "V" Then
Case Is = "Sal"
Else
If Case = "K" Then
Case Is = "Dep"
Else
If Case = "A" Then
Case Is = "Auf"
Else
If Case = "M" Then
Case Is = "Mon"
Else
If Case = "T" Then
Case Is = "Tec"
Else
If Case = "W" Then
Case Is = "Ver"
Else
If Case = "B" Then
Case Is = "Ber"
Else
If Case = "P" Then
Case Is = "Ver"
Else
GoTo GoNext
End If
End If
End If
End If
End If
End If
End If
End If
Use Select Case
Sub test()
Dim strCode As String
Dim strVal As String
strCode = "B"
Select Case strCode
Case "A"
strVal = "Jan"
Case "B"
strVal = "Feb"
Case "C"
strVal = "Mar"
Case Else
strVal = "No match found"
End Select
End Sub
Using Select Case ... End Select
But you need to declare a variable, let us say x to be the reference
Dim x as String, y as String
'Allocate value to the `x` variable. In any way. Then:
Select Case x
Case "V": y = "Sal"
Case "K": y = "Dep"
Case "A": y = "Auf"
' and so on...
Case Else: y = "Whatever..."
End Select
Finally you obtain the y value according to the x one...
As usual, multiple ifs are simplified into one dictionary / hash table / object .
Dim variablename
Set variablename = CreateObject("Scripting.Dictionary")
variablename.Add ("V", "Sal")
variablename.Add ("K", "Dep")
....
variablename.Add ("P", "Var")
Get the variable as follows
ans = 'Nothing'
if variablename.exists("P") then
ans = variablename("P")
Rem ans = variablename.item("P") ?
Rem Equals "Var"
end if
see also https://excelmacromastery.com/vba-dictionary/
What about the following:
If Case = "V" Then
ElseIf Case = "K" Then
ElseIf Case = "A" Then
...
End If
I'm attempting to code a CONCATENATEIFS function in VBA that works like SUMIFS, etc. Here's an example call:
=ConcatenateIfs(",",$E$6:$E$9,$F$6:$F$9,"Something",$G$6:$G$9,">=2")
Public Function ConcatenateIfs(JoinStr As String, StrRange As Range, ParamArray var() As Variant) As String
Dim numberOfConditions As Integer
numberOfConditions = (UBound(var) - LBound(var) + 1) / 2
Dim tmpResult As String
tmpResult = ""
Dim includeItem As Boolean
For Item = 1 To StrRange.Count
includeItem = True
For Condition = 1 To numberOfConditions:
If var((Condition - 1) * 2)(Item) <> var((Condition - 1) * 2 + 1) Then
includeItem = False
End If
Next Condition
If includeItem = True And Item = 1 Then
tmpResult = StrRange(Item)
ElseIf includeItem = True Then
tmpResult = tmpResult + JoinStr + StrRange(Item)
End If
Next Item
ConcatenateIfs = tmpResult
End Function
The above function never seems to recognize that a condition has been met, meaning this part of the code is not working (i.e. that it always evaluates the inequality to True):
If var((Condition - 1) * 2)(Item) <> var((Condition - 1) * 2 + 1) Then
includeItem = False
End If
How do I fix this so that the conditions are tested properly between an item of the criteria_range and the criteria itself? Bonus points: how do I break out of the condition loop as soon as a criteria (properly) is not met?
working in vb.net in Visual Studio on a datagridview.
The rows are days of the week. The rows all alternate backcolor (variables LightColour1 and LightColour2), then the weekend rows are variable WeekendRowsColour. That's all easy enough, but now I have to make the entire final column white. But I can't seem to override the row colors no matter how I approach it. Any advice?
Here's my code section:
For r = 0 To 27
dgv.Rows.Add()
dgv.Rows(r).Cells(0).Value = Format(nDate, "ddd")
dgv.Rows(r).Cells(1).Value = Format(nDate, "d/MM/yyyy")
If Format(nDate, "ddd") = "Sat" Or Format(nDate, "ddd") = "Sun" Then
dgv.Rows(r).DefaultCellStyle.BackColor = WeekendRowsColour
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = WeekendRowsSelColour
Else
If r Mod 2 = 0 Then 'even row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour1
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour1
Else 'alternate row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour2
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour2
End If
End If
nDate = DateAdd(DateInterval.Day, 1, nDate)
Next
dgv.Columns(dgv.Columns.Count - 1).DefaultCellStyle.BackColor = Color.White
But no matter how I approach it, the last column comes out the default color. My best success has been setting the backcolor and alternatingrowsbackcolor of the rows programmatically, and setting the column properties to white in the designer, but that doesn't overwrite the alternating rows or the weekend colors.
Pulling my hair out here!
You have to set it inside the loop per cell like this:
For r = 0 To 27
dgv.Rows.Add()
dgv.Rows(r).Cells(0).Value = Format(nDate, "ddd")
dgv.Rows(r).Cells(1).Value = Format(nDate, "d/MM/yyyy")
If Format(nDate, "ddd") = "Sat" Or Format(nDate, "ddd") = "Sun" Then
dgv.Rows(r).DefaultCellStyle.BackColor = WeekendRowsColour
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = WeekendRowsSelColour
Else
If r Mod 2 = 0 Then 'even row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour1
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour1
Else 'alternate row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour2
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour2
End If
End If
nDate = DateAdd(DateInterval.Day, 1, nDate)
dgv.Rows(r).Cells(dgv.Columns.Count-1).Style.BackColor = Color.White
Next
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
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.