VBA macro for hiding rows based on cell value - vba

I am working on a sheet that has sections which hides/shows a number of rows based on a cell value (between 1-10). At the moment, I have a handful of nested if statements. This has made my workbook painfully slow. Is there a way to shrink this code? Thanks.
If Range("B87").Value = 10 Then
Rows("88:98").EntireRow.Hidden = False
Else
If Range("B87").Value = 9 Then
Rows("98").EntireRow.Hidden = True
Rows("88:97").EntireRow.Hidden = False
Else
If Range("B87").Value = 8 Then
Rows("97:98").EntireRow.Hidden = True
Rows("88:96").EntireRow.Hidden = False
Else
If Range("B87").Value = 7 Then
Rows("96:98").EntireRow.Hidden = True
Rows("88:95").EntireRow.Hidden = False
Else
If Range("B87").Value = 6 Then
Rows("95:98").EntireRow.Hidden = True
Rows("88:94").EntireRow.Hidden = False
Else
If Range("B87").Value = 5 Then
Rows("94:98").EntireRow.Hidden = True
Rows("88:93").EntireRow.Hidden = False
Else
If Range("B87").Value = 4 Then
Rows("93:98").EntireRow.Hidden = True
Rows("88:92").EntireRow.Hidden = False
Else
If Range("B87").Value = 3 Then
Rows("92:98").EntireRow.Hidden = True
Rows("88:91").EntireRow.Hidden = False
Else
If Range("B87").Value = 2 Then
Rows("91:98").EntireRow.Hidden = True
Rows("88:90").EntireRow.Hidden = False
Else
If Range("B87").Value = 1 Then
Rows("90:98").EntireRow.Hidden = True
Rows("88:89").EntireRow.Hidden = False
Else
If Range("B87").Value = 0 Then
Rows("88:98").EntireRow.Hidden = True
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

You have a whole lot of basically the same code. I took a look and tried to make it more arithmetical, which shortens the code. See if this works:
Sub t()
Dim myVal As String
Dim mainRow As Long, tweakRow As Long
Dim hideRange As Range, showRange As Range
Dim row1 As Long, row2 As Long
mainRow = 98
myVal = Range("B87").Value
If myVal = 10 Then
Rows(mainRow - 10 & ":" & mainRow - 10 + myVal).EntireRow.Hidden = False
ElseIf myVal >= 1 And myVal <= 9 Then
tweakRow = mainRow - 10
row1 = (mainRow - (9 - myVal))
row2 = (mainRow - (10 - myVal))
Set hideRange = Rows(row1 & ":" & mainRow).EntireRow
Set showRange = Rows(tweakRow & ":" & row2).EntireRow
Debug.Print "For a value of " & myVal & ", we will hide range: " & hideRange.Address & ", and show range: " & showRange.Address
hideRange.Hidden = True
showRange.Hidden = False
ElseIf myVal = 0 Then
Rows(mainRow - 10 & ":" & mainRow).EntireRow.Hidden = True
End If
End Sub

I might try a case statement.
Oh, or even use the ElseIf option which would reduce the amount of EndIf statements at the very least.
I think the case code looks something like this:
Select Range("B87").value
Case "1"
Case "2"
...
End Select

You don't need to use EntireRow when using Rows or 'EntireColumnwhen usingColumns`.
Rows("88:98").Hidden = True
If Range("B87").Value > 0 Then
Rows(88).Resize(1 + Range("B87").Value).Hidden = False
End If

Related

How to Copy and Paste in First Empty Cell and End when Fulfilled

I have a spreadsheet of products, which are in particular fonts and backgrounds. I am trying to create a macro so when I perform the find function (CLTR-F), I can click a macro button which will copy my selection, and paste it into the first available cell in Row N starting with the second row ("N2") and ending with the 12th row ("N12").
I have more data in N, for example in N13 and N14, so I cannot simply count the rows occupied and add one. I want to make this code work so this process exits once the first cell has been pasted into. Currently my code simply pastes the selected cell into both N2 and N3. The goal is that once the value is pasted, the process ends. But if the value is not pasted, it will go onto the next available cell and paste, and end, and so on if the cells are occupied until it is pasted in the first empty cell. Below is what I have, and so far it pastes into both N2 and N3, (If N2 is not occupied.)
Sub CopyPasteFirstEmptyCell()
'Copy the selection
Selection.Copy
'Test for N2
If IsEmpty(Range("N2")) = True Then
Selection.Copy Range("N2")
End If
'Test for N3
If IsEmpty(Range("N2")) = True Then
Selection.Copy Range("N3")
'Test For N4-N12 etc. etc.
End Sub
Thank you so kindly for listening. I have looked at relevant threads and have not found a sufficient answer of yet, and I apologize if that answer already exists openly.
I created variables and added them to a final variable to decide the range.
Sub Copy()
'Copy the selection
Selection.Copy
'Create variables
Dim intN2 As Integer
Dim intN3 As Integer
Dim intN4 As Integer
Dim intN5 As Integer
Dim intN6 As Integer
Dim intN7 As Integer
Dim intN8 As Integer
Dim intN9 As Integer
Dim intN10 As Integer
Dim intN11 As Integer
Dim intN12 As Integer
Dim finalint As Integer
'Create If Then statements to increaes finalint
'For N2
If IsEmpty(Range("N2")) = True Then
intN2 = 0
ElseIf IsEmpty(Range("N2")) = False Then
intN2 = 1
End If
'For N3
If IsEmpty(Range("N3")) = True Then
intN3 = 0
ElseIf IsEmpty(Range("N3")) = False Then
intN3 = 1
End If
'For N4
If IsEmpty(Range("N4")) = True Then
intN4 = 0
ElseIf IsEmpty(Range("N4")) = False Then
intN4 = 1
End If
'For N5
If IsEmpty(Range("N5")) = True Then
intN5 = 0
ElseIf IsEmpty(Range("N5")) = False Then
intN5 = 1
End If
'For N6
If IsEmpty(Range("N6")) = True Then
intN6 = 0
ElseIf IsEmpty(Range("N6")) = False Then
intN6 = 1
End If
'For N7
If IsEmpty(Range("N7")) = True Then
intN7 = 0
ElseIf IsEmpty(Range("N7")) = False Then
intN7 = 1
End If
'For N8
If IsEmpty(Range("N8")) = True Then
intN8 = 0
ElseIf IsEmpty(Range("N8")) = False Then
intN8 = 1
End If
'For N9
If IsEmpty(Range("N9")) = True Then
intN9 = 0
ElseIf IsEmpty(Range("N9")) = False Then
intN9 = 1
End If
'For N10
If IsEmpty(Range("N10")) = True Then
intN10 = 0
ElseIf IsEmpty(Range("N10")) = False Then
intN10 = 1
End If
'For N11
If IsEmpty(Range("N11")) = True Then
intN11 = 0
ElseIf IsEmpty(Range("N11")) = False Then
intN11 = 1
End If
'For N12
If IsEmpty(Range("N12")) = True Then
intN12 = 0
ElseIf IsEmpty(Range("N12")) = False Then
intN12 = 1
End If
'Make finalint the total of all other integers
finalint = intN2 + intN3 + intN4 + intN5 + intN6 + intN7 + intN8 + intN9 + intN10 + intN11 + intN12
'Place selection depending on amount of finalint
If finalint = 0 Then
Selection.Copy Range("N2")
ElseIf finalint = 1 Then
Selection.Copy Range("N3")
ElseIf finalint = 2 Then
Selection.Copy Range("N4")
ElseIf finalint = 3 Then
Selection.Copy Range("N5")
ElseIf finalint = 4 Then
Selection.Copy Range("N6")
ElseIf finalint = 5 Then
Selection.Copy Range("N7")
ElseIf finalint = 6 Then
Selection.Copy Range("N8")
ElseIf finalint = 7 Then
Selection.Copy Range("N9")
ElseIf finalint = 8 Then
Selection.Copy Range("N10")
ElseIf finalint = 9 Then
Selection.Copy Range("N11")
ElseIf finalint = 10 Then
Selection.Copy Range("N12")
End If
End Sub

Assign a value to a cell by using 4 multiple choice checkboxes

I would like please to assign a value to a cell by using 4 multiple choice check boxes which their value is 1 per each box if their condition is true. I would like to sum up their value in the linked cell so that cell value can vary. If for instance:
all checkboxes condition is true the value in the linked cell is 4
A few of them are true the value in the linked cell can vary from 1-3
All of them are false the value in the linked cell is 0
If CheckBox1.Value = True Then Range("D2").Value = 1
If CheckBox1.Value = False Then Range("D2").Value = 0 etc.
I wish to solve this problem by using a vba macro.
Just set the macro foreach checkbox before clicking it.
Public count As Integer
Public Sub btn_Click()
Dim cbName As String
If (count = Null) Then
count = 0
End If
cbName = Application.Caller
If (Sheets("Tabelle1").Shapes(cbName).ControlFormat.Value = xlOn And count < 4) Then
count = count + 1
ElseIf (count > 0) Then
count = count - 1
End If
Range("A1").Value = count
End Sub
you can do this way. based on linked cells get the 1 if true or Zero if false. and then sum all values.
for VBA solution
Private Sub CheckBox1_Click()
Dim str As Integer
str = 0
If CheckBox1.Value = True Then str = str + 1
If CheckBox2.Value = True Then str = str + 1
If CheckBox3.Value = True Then str = str + 1
If CheckBox4.Value = True Then str = str + 1
Range("D2").Value = str
End Sub
This is the answer to my problem:
Option Explicit
Sub CheckBox1_Click()
Dim count As Integer
If (count = Null) Then
count = 0
End If
count = 0
If ActiveSheet.Shapes("Check Box 1").ControlFormat = xlOn Then count = count + 1
If ActiveSheet.Shapes("Check Box 2").ControlFormat = xlOn Then count = count + 1
If ActiveSheet.Shapes("Check Box 3").ControlFormat = xlOn Then count = count + 1
If ActiveSheet.Shapes("Check Box 4").ControlFormat = xlOn Then count = count + 1
Range("A1").Value = count
End Sub

VBA similar code works perfectly on one worksheet, but not the other

I have written the following code for one of my worksheets.
Sub Hide_Projects()
Application.ScreenUpdating = False
i = 6
For i = 6 To 350
Cells(9, i).Select
If Selection.Value = "Project" Then
ActiveCell.EntireColumn.Hidden = True
Else
ActiveCell.EntireColumn.Hidden = False
End If
Next i
Application.ScreenUpdating = True
End Sub
It works fine, does exactly what I need it to every time without crashing or lagging. However, when I use a similar code on a different worksheet, only this time applied to rows rather than columns, it either crashes my Excel or takes about 2 minutes to run, even though the code is identical. This is the second code:
Sub Hide_Projects_5yr()
Application.ScreenUpdating = False
i = 6
For i = 6 To 350
Cells(i, 7).Select
If Selection.Value = "Project" Then
ActiveCell.EntireRow.Hidden = True
Else
ActiveCell.EntireRow.Hidden = False
End If
Next i
Application.ScreenUpdating = True
End Sub
Does anyone have any idea why this is the case?
Thank you!
Obviously columns are times faster to hide than rows. I have tried this:
Option Explicit
Public Sub TestingSpeed()
Dim lngCount As Long
Dim dtTime As Date
Columns.Hidden = False
rows.Hidden = False
dtTime = Now
For lngCount = 1 To 300
rows(lngCount).Hidden = True
Next lngCount
Debug.Print "Rows: -> "; DateDiff("s", dtTime, Now())
dtTime = Now
For lngCount = 1 To 300
Columns(lngCount).Hidden = True
Next lngCount
Debug.Print "Cols: -> "; DateDiff("s", dtTime, Now())
End Sub
The result is the following (in seconds):
Rows: -> 9
Cols: -> 2
And the difference grows somehow exponentially.
With 1.000 samples it is like this:
Rows: -> 11
Cols: -> 1
With 10.000 like this:
Rows: -> 19
Cols: -> 10
It is very likely that your active sheet is not the one you intend to work on. It is always best to avoid Select and ActiveCell, because you are dependent on the cursor location. Not sure you need the false case, unless you use the same sheet over and over again and it may be hidden.
Sub Hide_Projects_5yr()
Application.ScreenUpdating = False
Dim ws as Worksheet
Set ws = Sheets("YourSheetName")
For i = 6 To 350
If ws.Cells(i, 7).Value = "Project" Then
ws.Cells(i, 7).EntireRow.Hidden = True
Else
ws.Cells(i, 7).EntireRow.Hidden = False
End If
Next i
Application.ScreenUpdating = True
End Sub
Could you try giving your code full addresses to your cells? Besides, it is a good idea not using the select command. Here's my modifications to your code:
Sub Hide_Projects()
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Put the name of your sheet here")
For i = 6 To 350
If .Cells(9, i).Text = "Project" Then
.Columns(i).Hidden = True
Else
.Columns(i).Hidden = False
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Your second code would look like this:
Sub Hide_Projects_5yr()
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Put the name of your second sheet here")
For i = 6 To 350
If .Cells(i, 7).Text = "Project" Then
.Rows(i).Hidden = True
Else
.Rows(i).Hidden = False
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Let me know if the error message keeps appearing.
Your main slowdown is a result of reading data from the worksheet too many times. Load the cell values into an array first, then loop through that.
You can also gain a bit of speed by unhiding the rows all at once at the outset, then hiding if the "="Project" condition is true. Again, this reduces the number of calls to the worksheet; your current version sets the ".Hidden" property of each row one-by-one.
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim tempArr As Variant
tempArr = Range(Cells(6, 7), Cells(350, 7)).Value
Rows("6:350").Hidden = False
j = 1
For i = LBound(tempArr, 1) To UBound(tempArr, 1)
If tempArr(i, 1) = "Project" Then
Rows(j + 5).Hidden = True
End If
j = j + 1
Next
Application.ScreenUpdating = True
If you're really concerned about speed, you could also reduce the number of trips to the worksheet by checking for consecutive rows containing "Project". This version runs ~2x as fast as the other one (tested on a sample of 200k rows). It makes the code a lot more complex, though.
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim k As Long
Dim tempArr As Variant
Dim consBool As Boolean
tempArr = Range(Cells(6, 7), Cells(350, 7)).Value
Rows("6:350").Hidden = False
j = 1
For i = LBound(tempArr, 1) To UBound(tempArr, 1)
consBool = True
If tempArr(i, 1) = "Project" Then
k = i
Do Until consBool = False
If k = UBound(tempArr, 1) Then
consBool = False
ElseIf tempArr(k + 1, 1) = "Project" Then
k = k + 1
Else
consBool = False
End If
Loop
Rows(j + 5 & ":" & k + 5).Hidden = True
j = j + 1 + (k - i)
i = k
Else
j = j + 1
End If
Next
Application.ScreenUpdating = True
Here's what it'd look like if I were going to implement this in a larger project. Among other optimizations, I've added some features (it can check for partial matches, check multiple columns for your criteria, and do an "inverted" mode that hides all rows not containing your criteria) and made sure that you're required to specify your worksheet.
Option Explicit
Sub exampleMacro()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Call hideRows(ThisWorkbook.Sheets("Example WS"), 6, 350, "Project", 7, 7)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub hideRows(ws As Worksheet, startRow As Long, endRow As Long, valCrit As String, Optional startCol As Long = 1, Optional endCol As Long = 1, Optional invert As Boolean = False, Optional checkAll As Boolean = False)
'Hides rows in a range (startRow to endRow) in a worksheet (ws)
'Hides when row contains a value (valCrit; partial strings are accepted) in a column or series of columns (startCol to endCol)
'In inverted mode (invert), hides rows that do *not* contain value
'If (checkAll) is True, all columns must contain value to be hidden/unhidden
'Usage examples:
'Call hideRows(exampleWS, 1, 1000, "Foo", 1, 10) -> hides rows that contain a cell in columns 1-10 with exact value "Foo"
'Call hideRows(exampleWS, 1, 1000, "*Foo*", 1, 10) -> hides rows that contain a cell in columns 1-10 that contains partial string "*Foo*"
'Call hideRows(exampleWS, 1, 1000, "Foo", 1, 10, True) -> hides rows that contain no cells in columns 1-10 with exact value "Foo"
'Call hideRows(exampleWS, 1, 1000, "Foo", 1, 10, False, True) -> hides rows in which all cells in columns 1-10 contain the exact value "Foo"
'Call hideRows(exampleWS, 1, 1000, "Foo", 1, 10, True, True) -> hides rows in which no cells in columns 1-10 contain the exact value "Foo"
Dim loopCounter As Long
Dim rowCounter As Long
Dim colCounter As Long
Dim endConsRow As Long
Dim tempArr As Variant
Dim toAdd As Long
Dim toHide As String
Dim consBool As Boolean
Dim tempBool As Boolean
Dim rowStr As String
Dim goAhead As Boolean
Dim i As Long
If startRow > endRow Then
toAdd = endRow - 1
Else
toAdd = startRow - 1
End If
ws.Rows(startRow & ":" & endRow).Hidden = False
tempArr = ws.Range(ws.Cells(startRow, startCol), ws.Cells(endRow, endCol)).Value
loopCounter = 1
For rowCounter = LBound(tempArr, 1) To UBound(tempArr, 1)
For colCounter = LBound(tempArr, 2) To UBound(tempArr, 2)
goAhead = False
If tempArr(rowCounter, colCounter) Like valCrit Then
If (Not checkAll) Or (colCounter = UBound(tempArr, 2)) Then
If invert Then
loopCounter = loopCounter + 1
Exit For
End If
goAhead = True
End If
ElseIf checkAll Or colCounter = UBound(tempArr, 2) Then
If Not invert Then
loopCounter = loopCounter + 1
Exit For
End If
goAhead = True
End If
If goAhead Then
endConsRow = rowCounter
consBool = True
Do Until consBool = False
tempBool = False
For i = LBound(tempArr, 2) To UBound(tempArr, 2)
If endConsRow = UBound(tempArr, 1) Then
Exit For
ElseIf tempArr(endConsRow + 1, i) Like valCrit Then
If (Not checkAll) Or (i = UBound(tempArr, 2)) Then
If Not invert Then
endConsRow = endConsRow + 1
tempBool = True
End If
Exit For
End If
ElseIf checkAll Or i = UBound(tempArr, 2) Then
If invert Then
endConsRow = endConsRow + 1
tempBool = True
End If
Exit For
End If
Next
If Not tempBool Then
consBool = False
End If
Loop
rowStr = loopCounter + toAdd & ":" & endConsRow + toAdd
If toHide = "" Then
toHide = rowStr
ElseIf Len(toHide & "," & rowStr) > 255 Then
ws.Range(toHide).EntireRow.Hidden = True
toHide = rowStr
Else
toHide = toHide & "," & rowStr
End If
loopCounter = loopCounter + 1 + (endConsRow - rowCounter)
rowCounter = endConsRow
Exit For
End If
Next
Next
If Not toHide = "" Then
ws.Range(toHide).EntireRow.Hidden = True
End If
End Sub

Outputting sine waves on xy plots — stuck on certain parts

Please help I want to know exactly what is going on in this code for a questions and answers exam tomorrow.
I don't need any help with writing the code because that would be cheating. I made a tiny few mistakes please forgive me I rectified most of theses I don't need help with the mistakes just with the comments and understanding mostly how it works.
Private Sub Command1_Click()
MSComm1.Output = "83" + Chr$(13)
End Sub
Private Sub Form_Load()
MSC1.PortOpen = True
Average_val = 0
minimum_val = 255
maximum_val = 0
Screenshotofsinewave.Left = 0
Screenshotofsinewave.Channel(0).TraceVisible = True
Screenshotofsinewave.Channel(0).MarkersVisible = True
sumofall_val = 0
Screenshotofsinewave.TitleVisible = False
Screenshotofsinewave.Top = 0
Screenshotofrectifiedsinewave.TitleVisible = False
Screenshotofrectifiedsinewave.Channel(0).TraceVisible = True
Screenshotofrectifiedsinewave.Channel(0).MarkersVisible = True
Screenshotofrectifiedsinewave.Top = 0
Screenshotofrectifiedsinewave.Left = 0
Screenshotoflevelshiftedsinewave.Top = 0
Screenshotoflevelshiftedsinewave.Left = 0
Screenshotoflevelshiftedsinewave.TitleVisible = False
Screenshotoflevelshiftedsinewave.Channel(0).TraceVisible = True
Screenshotoflevelshiftedsinewave.Channel(0).MarkersVisible = True
End Sub
Private Sub MSC1_OnComm()
Dim number_val
Dim number1_val
Dim Average_val
Dim com1_val
p = 0
q = 0
r = 0
s = 0
t = 0
Dim Xarr(50) As Single
Dim Yarr(50) As Single
Dim number2_val
Dim number3_val
Dim Snapshotofsinewave
Dim string1_out As String
Dim string1_in As String
Dim counter As Single
Dim sample_rate As Integer
Select Case MSC1.CommEvent
Case comEvReceive
minimum_val = 255
string1_in = MSC1.Input
Screenshotofsinewave.Channel(0).Clear
Screenshotofrectifiedsinewave.Channel(0).Clear
Screenshotoflevelshiftedsinewave.Channel(0).Clear
counter = 0
comm_count = comm_count + 1
For sample_rate = 1 To 150 Step 3
string1_out = Mid(string1_in, sample_rate, 3)
counter = counter + 1
number_val = Val(string1_out)
Xarr(counter) = counter
Yarr(counter) = number_val
Screenshotofsinewave.Channel(0).AddXY counter, number_val
If number_val > maximum_val Then
maximum_val = number_val
MaxVoltage.Value = maximum_val
End If
If number_val < minimum_val Then
minimum_val = number_val
MinVoltage.Value = number_val
End If
sumofall_val = number_val + sumofall_val
Average_value = sumofall_val / 50
AverageVoltage.Value = Average_value
Next sample_rate
counter = 0
sumofall_val = 0
For sample_rate = 1 To 150 Step 3
string1_out = Mid(string1_in, sample_rate, 3)
counter = counter + 1
number_val = Val(string1_out)
number_val = number1_val - Average_value
number_val = numer_val
If num_val1 < 0 Then
number_val = number_val * -1
End If
Xarr(counter) = counter
Yarr(counter) = number1_val
Screenshotofrectifiedsinewave.Channel(0).AddXY counter, number1_val
Next sample_rate
counter = 0
For sample_rate = 1 To 150 Step 3
string1_out = Mid(string1_in, sample_rate, 3)
Count = Count + 1
number_val = Val(string1_out)
number2_val = number_val + Average_value
Xarr(Count) = counter
Yarr(Count) = number2_val
LevelShifted.Channel(0).AddXY Count, number_val2
sumofall_val = number_val + sumofall_val
Next sample_rate
counter = com1_val
Snapshotofsinewave.Value = com1_val
End Select
End Sub
Private Sub Frame4_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub Uploaddata_Click()
If GXSwitch1.SwitchOn = True Then
led1.LampOn = True
p = 8
Else
led1.LampOn = False
p = 0
End If
If GXSwitch2.SwitchOn = True Then
led2.LampOn = True
q = 4
Else
led2.LampOn = False
q = 0
End If
If GXSwitch3.SwitchOn = True Then
led3.LampOn = True
r = 4
Else
led3.LampOn = False
r = 0
End If
If GXSwitch4.SwitchOn = True Then
led4.LampOn = True
s = 8
Else
led4.LampOn = False
s = 0
End If
t = p + q + r + s
If t = 0 Then
MSC1.Output = "0" + Chr$(13)
End If
If t = 1 Then
MSC1.Output = "1" + Chr$(13)
End If
If t = 2 Then
MSC1.Output = "2" + Chr$(13)
End If
If t = 3 Then
MSC1.Output = "3" + Chr$(13)
End If
If t = 4 Then
MSC1.Output = "4" + Chr$(13)
End If
If t = 5 Then
MSC1.Output = "5" + Chr$(13)
End If
If t = 6 Then
MSC1.Output = "6" + Chr$(13)
End If
If t = 7 Then
MSC1.Output = "7" + Chr$(13)
End If
If t = 8 Then
MSC1.Output = "8" + Chr$(13)
End If
If t = 9 Then
MSC1.Output = "9" + Chr$(13)
End If
If t = 10 Then
MSC1.Output = "10" + Chr$(13)
End If
If t = 11 Then
MSC1.Output = "11" + Chr$(13)
End If
If t = 12 Then
MSC1.Output = "12" + Chr$(13)
End If
If t = 13 Then
MSC1.Output = "13" + Chr$(13)
End If
If t = 14 Then
MSC1.Output = "14" + Chr$(13)
End If
If t = 15 Then
MSC1.Output = "15" + Chr$(13)
End If
End Sub
Depends on several factors...
Dim average_val, x As Decimal ' decimal
Dim average_val = 3.2D ' decimal if Option Infer On
Dim average_val = 3.2D ' object with boxed decimal if Option Infer Off
Dim average_val ' Object if Option Strict Off, otherwise an error

Using a loop in Excel/VBS to populate a form

Please can somebody help me with the correct DIM statements and syntax to simplify the following into a DO UNTIL loop?:
Sub DesRisk_Loader()
Dim Qn(7) As String
Dim Ys(7) As String
Dim No(7) As String
Dim Wk(7) As Integer
Application.ScreenUpdating = False
n = 1
x = 1
Do
Application.Goto Reference:="DesHome"
ActiveCell.Offset(x, 0).Select
Qn(n) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Ys(n) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
No(n) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Wk(n) = ActiveCell.Value
x = x + 2
n = n + 1
Loop Until n = 8
''Q.1
If Qn(1) <> "" Then
DesForm.DesFrame1.Visible = True
DesForm.Dq1.Caption = Qn(1)
FH = 0
If Ys(1) = "P" Then
DesForm.D1y.Value = True
Else
DesForm.D1y.Value = False
End If
If No(1) = "O" Then
DesForm.D1n.Value = True
Else
DesForm.D1n.Value = False
End If
DesForm.DesDly1.Value = Wk(1)
Else:
Exit Sub
End If
''Q.2
If Qn(2) <> "" Then
DesForm.DesFrame2.Visible = True
DesForm.Dq2.Caption = Qn(2)
FH = 1
If Ys(2) = "P" Then
DesForm.D2y.Value = True
Else
DesForm.D2y.Value = False
End If
If No(2) = "O" Then
DesForm.D2n.Value = True
Else
DesForm.D2n.Value = False
End If
DesForm.DesDly2.Value = Wk(2)
Else: GoTo Jump1
End If
''Q.3
If Qn(3) <> "" Then
DesForm.DesFrame3.Visible = True
DesForm.Dq3.Caption = Qn(3)
FH = 2
If Ys(3) = "P" Then
DesForm.D3y.Value = True
Else
DesForm.D3y.Value = False
End If
If No(3) = "O" Then
DesForm.D3n.Value = True
Else
DesForm.D3n.Value = False
End If
DesForm.DesDly3.Value = Wk(3)
Else: GoTo Jump1
End If
ditto till..
''Q.7
If Qn(7) <> "" Then
DesForm.DesFrame7.Visible = True
DesForm.Dq7.Caption = Qn(7)
FH = 6
If Ys(7) = "P" Then
DesForm.D7y.Value = True
Else
DesForm.D7y.Value = False
End If
If No(7) = "O" Then
DesForm.D7n.Value = True
Else
DesForm.D7n.Value = False
End If
DesForm.DesDly7.Value = Wk(7)
Else: GoTo Jump1
End If
Jump1:
DesForm.Height = 140 + (FH * 75)
DesForm.DesOK.Top = 85 + (FH * 75)
DesForm.DesCancel.Top = 85 + (FH * 75)
Load DesForm
DesForm.Show
End Sub
Thanks
Scott
At the top of your code (First Line in the entire module), type the following OPTION EXPLICIT
That will help identify all undeclared variables.