I am trying to have an entry data userform where the input starts at "A19" and will end at row "A30" once the empty rows get filled 1 by 1, instead of the current situation where it starts at "A1" and goes unrestricted.
Private Sub cmdAdd_Click()
Dim wks As Worksheet
Dim AddNew As Range
Set wks = ActiveSheet
Set AddNew = wks.Range("A2:A65565").End(xlUp).Offset(1, 0)
AddNew.Offset(0, 2).Value = txtCAC.Text
AddNew.Offset(0, 4).Value = txtName.Text
AddNew.Offset(0, 5).Value = txtType.Text
AddNew.Offset(0, 6).Value = txtClass.Text
AddNew.Offset(0, 7).Value = txtDate.Text
AddNew.Offset(0, 8).Value = txtParent.Text
AddNew.Offset(0, 9).Value = txtManagement.Text
AddNew.Offset(0, 10).Value = txtSuccess.Text
AddNew.Offset(0, 12).Value = txtPercentage.Text
AddNew.Offset(0, 21).Value = txtCommittment.Text
AddNew.Offset(0, 38).Value = txtContribution.Text
AddNew.Offset(0, 40).Value = txtRedemption.Text
lstDisplay.ColumnCount = 41
lstDisplay.RowSource = "A2:A65356"
End Sub
As apparently your goal is to overwrite an adjacent fixed target range
with a complete set of textbox entries, I'd propose the following steps:
[0.] Define the fixed start cell in target cell e.g. via set tgt = Sheet1.Range("A19").
[1. a)] Split a list of needed textbox names thus getting a 1-dimensional array, which btw will be 0-based automatically.
[1. b)] Provide for data by a 2-dim data array and make it zero-based, too in order to
synchronize both array counters in the following loop (1.c).
[1. c)] Fill the data array rows with all textbox contents by a For..Next loop
and check for not allowed zero-length inputs;
if there are any display a warning message and redirect focus to the empty textbox.
[2.] Eventually dump back the data array to the chosen target range
by using the number of listed textbox controls cnt to .Resize the target range (e.g. 12 in OP).
Private Sub cmdAdd_Click()
'0. Define fixed start cell in target range
dim tgt as Range
set tgt = Sheet1.Range("A19") ' change to any wanted sheet Code(Name)
'1. a) split a list of needed textbox names getting a 1-dim 0-based array automatically
Dim myTextboxes As Variant
myTextboxes = Split( _
"txtCAC,txtName,txtType,txtClass,txtDate,txtParent,txtManagement," & _
"txtSuccess,txtPercentage,txtCommittment,txtContribution,TxtRedemption", _
",")
Dim cnt As Long
cnt = UBound(myTextboxes) + 1 ' count number of textboxes
' b) provide for data by a 2-dim data array (make it zero-based, too)
Dim data As Variant
ReDim data(0 To cnt - 1, 0 To 0) ' define dimensions holding data
' c) fill data array rows with all textbox contents
Dim i As Long, ctrl As MSForms.Control
For i = LBound(data) To UBound(data) ' i.e. 0 To 11
Set ctrl = Me.Controls(myTextboxes(i)) ' set control to memory
data(i, 0) = ctrl.Text ' get textbox content
' check for complete entries or exit sub
If Len(Trim(data(i, 0))) = 0 Then ' check for zero-length input
MsgBox "Fill in empty Textbox(es) first!", vbExclamation, ctrl.Name
ctrl.SetFocus ' set focus to empty box
Exit Sub ' escape procedure
End If
Next
'2. dump data to target range
tgt.Resize(cnt, 1) = data ' write data
End Sub
Further hints
I think there will be to need to define a RowSource (btw better to use "Sheet1!A19:A30" if you are overwriting all data anyway by command button.
Side note: Prefer to get a last row cell via e.g. Sheet1.Range("A" & .Rows.Count).End(xlUp) or the row index via .Range("A" & .Rows.Count).End(xlUp).Row instead of coding a fixed rows count (current sheets have at about 1 million). You might be interested in reading Finding last used cell
`
Dim wks As Worksheet
Dim AddNew As Range
Set wks = ActiveSheet
Dim h As Integer
h = wks.Range("C65356").End(xlUp).Row
If h < 18 Then h = 18
if h > 30 then exit Sub
Set AddNew = wks.Range("A" & h)
AddNew.Offset(1, 2).Value = txtCAC.Text
AddNew.Offset(1, 4).Value = txtName.Text
AddNew.Offset(1, 5).Value = txtType.Text
AddNew.Offset(1, 6).Value = txtClass.Text
AddNew.Offset(1, 7).Value = txtDate.Text
AddNew.Offset(1, 8).Value = txtParent.Text
AddNew.Offset(1, 9).Value = txtManagement.Text
AddNew.Offset(1, 10).Value = txtSuccess.Text
AddNew.Offset(1, 12).Value = txtPercentage.Text
AddNew.Offset(1, 21).Value = txtCommittment.Text
AddNew.Offset(1, 38).Value = txtContribution.Text
AddNew.Offset(1, 40).Value = txtRedemption.Text
'lstDisplay.ColumnCount = 41
'lstDisplay.RowSource = "A2:A65356"
Related
I would like populate the blue area with random numbers.
sum of C3 to R3 should be equal to B3 value: 124
also;
sum of C3 to C26 should be equal to C2 value: 705
I tried to achieve it with the following code:
(this code was originally posted here: Code by #Mech
Sub RandomNumbersArray()
' dim your variables. this tells vba what type of variable it is working with
Dim lRow As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("SPLIT BY DAYS")
' find the last row in column b (2) in the above defined ws
lRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
' loop through rows 3 to last row
For i = 3 To lRow
' generate a random number between 0 and the row contents of column B (5)
ws.Cells(i, 3).Value = Int(Rnd() * (ws.Cells(i, 2).Value + 1))
' generate a random number between 0 and the difference between column B and colum C
ws.Cells(i, 4).Value = Int(Rnd() * (ws.Cells(i, 2).Value - ws.Cells(i, 3).Value))
' subtract the difference between column B and the sum of column C and column D
ws.Cells(i, 5).Value = ws.Cells(i, 2).Value - (ws.Cells(i, 3).Value + ws.Cells(i, 4).Value)
' subtract the difference between column B and the sum of column C and column D and column E
ws.Cells(i, 6).Value = ws.Cells(i, 2).Value - (ws.Cells(i, 3).Value + ws.Cells(i, 4).Value + ws.Cells(i, 5).Value)
' subtract the difference between column B and the sum of column C and column D and column E and column F
ws.Cells(i, 7).Value = ws.Cells(i, 2).Value - (ws.Cells(i, 3).Value + ws.Cells(i, 4).Value + ws.Cells(i, 5).Value + ws.Cells(i, 6).Value)
Next i
' sum column C (column 3) and place the value in C2
ws.Cells(2, 3).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 3), Cells(lRow, 3)))
' sum column D (column 4) and place the value in D2
ws.Cells(2, 4).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 4), Cells(lRow, 4)))
' sum column E (column 5) and place the value in E2
ws.Cells(2, 5).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 5), Cells(lRow, 5)))
' sum column F (column 6) and place the value in F2
ws.Cells(2, 6).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 6), Cells(lRow, 6)))
' sum column G (column 7) and place the value in F2
ws.Cells(2, 7).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 7), Cells(lRow, 7)))
End Sub
EDIT: Just to clarify, no negative numbers.
Here is something to try:
Set all cells to 0. Create a list of all cells (some kind of reference to each cell).
Now, randomly choose a cell from your list, and add 1 to that cell. The very first time, all cells will be 0, except for one, which will now be 1.
For this cell that you just incremented, add up the row and column and see if the sums have been reached. If either the row or the column sum has been reached, remove this cell reference from the list.
Repeat (randomly choose a cell from those remaining on the list) until the list is empty.
At each iteration you are randomly choosing one of the remaining cells in the reference list (not choosing from all the cells) and this list is getting smaller and smaller as column or row sums are reached.
It should be the case that random cells will increment, and if the columns and sums can in fact be calculated by values without logical inconsistencies, you should fairly quickly reach that point when the reference list falls empty.
I have a solution.
Answers so far have mostly been about finding values which are random, then fixing them to fit the totals.
I tried finding a calculated (non random) solution that fits the totals, then made a separate sub to randomize it. This way you can prevent the randomization from introducing negative values.
There are two procedures, This sub will call them both on the same Range.
Sub Call_Random_Array
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("SPLIT BY DAYS")
Dim RangeToFill as Range: Set RangeToFill = ws.Range("C3:R26") 'Edit this line to select whatever range you need to fill randomly
'Proportionately fill the array to fit totals:
Call ProportionateFillArray(RangeToFill)
'Randomize it x times
For x = 1 to 10 'increase this number for more randomisation
Call RandomizeValues(RangeToFill)
Next
End Sub
Proportionately fill the array to fit totals:
Sub ProportionateFillArray(rngAddress As Range)
Dim ws As Worksheet: Set ws = rngAddress.Worksheet
'Horizontal and Vertical target values as ranges:
Dim hTarg As Range, vTarg As Range
Set hTarg = rngAddress.Rows(1).Offset(-1, 0)
Set vTarg = rngAddress.Columns(1).Offset(0, -1)
'Check the totals match
If Not WorksheetFunction.Sum(hTarg) = WorksheetFunction.Sum(vTarg) Then
'totals don't match
MsgBox "Change the targets so both the horizontal and vertical targets add up to the same number."
Exit Sub
End If
With rngAddress
'Now fill rows and columns with integers
Dim Row As Long, Col As Long
For Row = 1 To .Rows.Count
For Col = 1 To .Columns.Count
.Cells(Row, Col) = Int( _
hTarg.Cells(Col) * vTarg.Cells(Row) / WorksheetFunction.Sum(hTarg) _
)
Next
Next
'Correct rounding errors
For Row = 1 To .Rows.Count
For Col = 1 To .Columns.Count
If Row = .Rows.Count Then
'Last row, so this column must be corrected come what may
.Cells(Row, Col) = .Cells(Row, Col) - WorksheetFunction.Sum(.Columns(Col)) + hTarg.Cells(Col)
ElseIf Col = .Columns.Count Then
'Last column, so must be corrected come what may
.Cells(Row, Col) = .Cells(Row, Col) - WorksheetFunction.Sum(.Rows(Row)) + vTarg.Cells(Row)
ElseIf _
(WorksheetFunction.Sum(.Rows(Row)) - vTarg.Cells(Row)) * _
(WorksheetFunction.Sum(.Columns(Col)) - hTarg.Cells(Col)) > 0 Then
'both row and column are incorrect in the same direction
.Cells(Row, Col) = .Cells(Row, Col) - WorksheetFunction.Max( _
WorksheetFunction.Sum(.Rows(Row)) - vTarg.Cells(Row), _
WorksheetFunction.Sum(.Columns(Col)) - hTarg.Cells(Col))
End If
Next
Next
End With
End Sub
Randomize an array without changing row or column totals:
Sub RandomizeValues(rngAddress As Range)
Dim ws As Worksheet: Set ws = rngAddress.Worksheet
Dim rngIncrease(1 To 2) As Range, rngDecrease(1 To 2) As Range, lDiff As Long
With rngAddress
'Select two cells to increase at random
For a = 1 To 2
Set rngIncrease(a) = .Cells(RndIntegerBetween(1, .Rows.Count), RndIntegerBetween(1, .Columns.Count))
rngIncrease(a).Select
Next
'Corresponding cells to decrease to make totals the same:
Set rngDecrease(1) = ws.Cells(rngIncrease(1).Row, rngIncrease(2).Column)
Set rngDecrease(2) = ws.Cells(rngIncrease(2).Row, rngIncrease(1).Column)
'Set the value to increase/decrease by - can't be more than the smallest rngDecrease Value, to prevent negative values
If Not WorksheetFunction.Min(rngDecrease) > 1 Then
'Don't decrease a value below 1
Exit Sub
Else
lDiff = RndIntegerBetween(1, WorksheetFunction.Min(rngDecrease)-1)
End If
'Now apply the edits
For a = 1 To 2
rngIncrease(a) = rngIncrease(a) + lDiff
rngDecrease(a) = rngDecrease(a) - lDiff
Next
End With
End Sub
'The below is the Random Integer function, I also used it in my other answer
Function RndIntegerBetween(Min As Long, Max As Long) As Long
RndIntegerBetween = Int((Max - Min + 1) * Rnd + Min)
End Function
This code is for what you were trying to do, not exactly how you explained it though (see comments). If this is what you were looking for, then your explanation was a bit off, otherwise let me know what you did mean.
Sub RandomNumbersArray()
Dim lRow As Long, lColumn As Long, remainingValue As Long
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("SPLIT BY DAYS")
lRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
lColumn = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
For i = 3 To lRow 'loop through the rows
remainingValue = ws.Cells(i, 2).Value2
For j = 3 To lColumn 'loop through all the columns per row
' generate a random number between 0 and the row contents of column B - previous column
If j = lColumn Then 'last cell can't be random unless you want to extend the columns until the sum in B-column is met
ws.Cells(i, j).Value2 = remainingValue
Else
ws.Cells(i, j).Value2 = Int((remainingValue + 1) * Rnd)
End If
remainingValue = remainingValue - ws.Cells(i, j).Value2
Next j
Next i
For j = 3 To lColumn 'loop through the columns to set the sum
ws.Cells(2, j).Value2 = Application.WorksheetFunction.Sum(Range(Cells(3, j), Cells(lRow, j)))
Next j
End Sub
I'm yet to get past the O-column with any value above 0 however
I have written a simple VBA script (code below) that should inspect every cell in a certain column. Here I want to do some string manipulation ( i wante to search for "." in the string and then take the right side, but because I could not get it to work I always take the 4 digit as a start). I then copy the manipulated string into another cell and later back. The code works, but for some reason, it takes ages to run on only 35 cells!
I´m still a kook on VBA and wanted to get input what could be the reason for it and what I could improve to get a faster runtime. Is it because I take all strings froms 4 up to 50 ?
Sub EditStatus()
Application.DisplayAlerts = False
ActiveSheet.Name = "Backend"
myNum = Application.InputBox("Please enter the row number until which you would like to update the status column (only for new entries)")
For i = 2 To myNum
Cells(i, 20).Value = Mid(Cells(i, 10), 4, 50)
Cells(i, 10).Value = Cells(i, 20).Value
Next i
Range("T1:T200").Clear
Application.DisplayAlerts = True
End Sub
Thanks
No need for a loop. You can enter the formula in the entire range in 1 go and then convert them to values before putting the values back in Col J
Replace
For i = 2 To myNum
Cells(i, 20).Value = Mid(Cells(i, 10), 4, 50)
Cells(i, 10).Value = Cells(i, 20).Value
Next i
With
With Range("T2:T" & myNum)
.Formula = "=MID(J2, 4, 50)"
.Value = .Value
Range("J2:J" & myNum).Value = .Value
End With
Alternatively, you can directly perform the same action in Col J without the helper column T. For example you can do all that in 1 line as explained HERE as well
Simply replace
For i = 2 To myNum
Cells(i, 20).Value = Mid(Cells(i, 10), 4, 50)
Cells(i, 10).Value = Cells(i, 20).Value
Next i
Range("T1:T200").Clear
with
Range("J2:J" & myNum).Value = Evaluate("Index(MID(" & "J2:J" & myNum & ", 4, 50),)")
Replace Values In-Place
Adjust the values in the constants section.
This solution overwrites the data and doesn't use a helper column, but you can test it with one indicated near the end of the code.
Solve the renaming (Backend) part as needed.
The Code
Option Explicit
Sub EditStatus()
' Define constants.
Const sPrompt As String = "Please enter the row number until which you " _
& "would like to update the status column (only for new entries)"
Const sTitle As String = "Enter Number"
Const wsName As String = "Backend"
Const First As Long = 2
Const cCol As Long = 10 ' J
Const Delim As String = "."
' Define workbook.
Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
' Require input.
Dim Last As Variant
Last = Application.InputBox( _
Prompt:=sPrompt, Title:=sTitle, Default:=First, Type:=1)
' Validate input.
If VarType(Last) = vbBoolean Then
MsgBox "You cancelled."
Exit Sub
End If
If Last < First Then
MsgBox "Enter a number greater than " & First - 1 & "."
Exit Sub
End If
If Int(Last) <> Last Then
MsgBox "Enter a WHOLE number greater than " & First - 1 & "."
Exit Sub
End If
' Define column range.
Dim rg As Range
Set rg = wb.Worksheets(wsName).Cells(First, cCol).Resize(Last - First + 1)
' Write values from column range to array.
Dim Data As Variant
If rg.Rows.Count > 1 Then
Data = rg.Value
Else
ReDim Data(1 To 1, 1 To 1): Data = rg.Value
End If
' Declare additional variables
Dim cValue As Variant ' Current Value
Dim i As Long ' Current Row (Array Row Counter)
Dim fPos As Long ' Current Delimiter Position
' Replace strings containing the delimiter, with the sub string
' to the right of it.
For i = 1 To UBound(Data)
cValue = Data(i, 1)
If Not IsError(cValue) Then
fPos = InStr(1, cValue, Delim)
If fPos > 0 Then
Data(i, 1) = Right(cValue, Len(cValue) - fPos)
End If
End If
Next i
' Maybe rather test with the following (writes to column 20 ("T")).
'rg.Offset(, 10).Value = Data
' Write values from array to column range.
rg.Value = Data
End Sub
I am trying to delete row based upon their values (i.e. if a cell contains the word DELETE) then the entire row should be deleted and shifted up.
I currently have code that loops through data and applies the cell value "IN-SCOPE" or "DELETE" to column 11 depending on the date present in Column 4. This works fine - however, the code I've written to delete any items labeled with "DELETE" doesn't do anything. Below is the code I currently have - any help would be great.
'Loop that lables items as in-scope IF they fall within the user defined range
y = 2
StartDate = Controls.Cells(15, 10).Value
EndDate = Controls.Cells(15, 11).Value
Bracknell.Activate
Cells(1, 11).Value2 = "Scope Check"
Do While Cells(y, 4).Value <> ""
If Cells(y, 9).Value >= StartDate And Cells(y, 9).Value < EndDate Then
Cells(y, 11).Value = "IN-SCOPE"
Else: Cells(y, 11).Value = "DELETE"
End If
y = y + 1
Loop
'Loop to delete out of scope items
Bracknell.Activate
z = 1
Do While Cells(z, 4).Value <> ""
If Cells(z, 11).Value = "DELETE" Then
Range("A" & z).EntireRow.Delete shift:=xlUp
End If
z = z + 1
Loop
Try this, the code is self explained:
Option Explicit
'use option explicit to force yourself
'to declare all your variables
Sub Test()
'Loop that lables items as in-scope IF they fall within the user defined range
Dim StartDate As Date
StartDate = Controls.Cells(15, 10).Value
Dim EndDate As Date
EndDate = Controls.Cells(15, 11).Value
With Bracknell
'Instead deleting every row, store them into a range variable
Dim RangeToDelete As Range
'Calculate your last row with data
Dim LastRow As Long
'Assuming your column 4 has data on all the rows
'If not, change that 4 for a column index that has data.
LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
'The most efficient way to loop through cells
'is using For Each loop
Dim cell As Range
.Cells(1, 11) = "Scope Check"
'loop through every row in column 4
For Each cell In .Range(.Cells(2, 4), .Cells(LastRow, 4))
'if the cell of that row in column 9 is between
If .Cells(cell.Row, 9) >= StartDate And .Cells(cell.Row, 9) < EndDate Then
.Cells(cell.Row, 11) = "IN-SCOPE"
Else
'if not, check if rangetodelete is empty
If RangeToDelete Is Nothing Then
'if it is empty, set it as the cell
Set RangeToDelete = cell
Else
'if not, set it as what it already is and the new cell
Set RangeToDelete = Union(RangeToDelete, cell)
End If
End If
Next cell
'Once you ended the loop you'll get the variable
'with every cell that didn't meet your criteria
'Check if is nothing, which means there are no cell to delete
If Not RangeToDelete Is Nothing Then RangeToDelete.EntireRow.Delete
End With
End Sub
I have a ComboBox that has a Value of "ConcretePad". I also have a Range named "ConcretePad".
i am trying to Select Range based off of ComboBox Value.
***Private Sub CatagoryCB_Change()
Dim rg As String
rg = (CatagoryCB.Value)
Worksheets("Data").Select
If (CatagoryCB.Value = "") Then
GoTo Line2
ElseIf (CatagoryCB.Value <> "") Then
Range(rg).Select
Line2:
End If
End Sub***
Trying to make rg represent the Value of CatagoryCB.Value, which i did but when i put it in the cell reference for range i get an error
You're probably looking for something like this (provided you're using a ListFillRange):
Private Sub CatagoryCB_Change()
If (CatagoryCB.ListIndex <> -1) Then
Worksheets("Data").Select
Range(CatagoryCB.ListFillRange).Cells(CatagoryCB.ListIndex + 1, 1).Select
End If
End Sub
This just grabs the ListFillRange, navigates to the ListIndex which is in sync with it and selects it.
CatagoryCB.ListIndex will return the index of the selected item in the list.
If a value that isn't in the list is selected, it will return -1.
So, for example, if I set my ListFillRange to A1:A3 and select the first option, I will do a Range("A1:A3").Cells(1, 1).Select because the ListIndex of the selected item is 0 (first item) and .Cells(0 + 1, 1) = .Cells(1, 1).
If you're populating the ComboBox manually, you'd need to give it the range you want to link to or perform a find operation.
It's hard to tell from your code.
I figured it out. My (CatagoryCB.Value) was not equal to my Range Name. This is the code i was able to produce to add a part to my datasheet on my current worksheet. This also adds the new row to my range
Dim i As String
Dim c As Integer
Dim g As Integer
i = CatagoryCB.Value
Worksheets("Data").Select
If i = "" Then
GoTo Line2
ElseIf i <> "" Then
Range(i).Select
c = Range(i).Count
Range(i).Activate
ActiveCell.Offset(c, 0).Select
g = ActiveCell.Row
Worksheets("Data").Rows(g).Insert
Range(i).Resize(c + 1).Name = i
Cells(g, 1).FormulaR1C1 = Cells(g - 1, 1).FormulaR1C1
Cells(g, 3) = (Part_NumberTB.Value)
Cells(g, 4) = (VendorCB.Value)
Cells(g, 5) = (DescriptionTB.Value)
Cells(g, 7) = (CostTB.Value)
Cells(g, 8) = (CostTB.Value * 1.35)
Cells(g, 9) = (CostTB.Value * 1.35)
Cells(g, 10).FormulaR1C1 = Cells(g - 1, 10).FormulaR1C1
Cells(g, 11).FormulaR1C1 = Cells(g - 1, 11).FormulaR1C1
Line2:
End If
I am trying to do a loop through the columns of two rows to add data from one sheet to another. This is additional data that was not dealt with in the previous code (since the previous code had specific logic to populate it).
I tried creating a sub to loop through the current rows on each page, but I am getting a byreference error. One of the ranges is the whole destination row, which is offset (incremented) every time it is populated. The other range is the source material, and covers a column in the source sheet. Other columns are accessed via offset. It am doing much of my work in a For/Each of the source range.
When I create the sub and try to pass the second range (bar), I get the error. I am trying to access the 'bar' object in the For/Each, so that both pages are dealing with the same row. This doesn't appear to be working.
Do I need to reDim, or find some other way to pass the appropriate range to the looping function?
Relevant code:
looping sub (very simple) -
Private Sub LoopThru38(thisRow As Range, sourceRow As Range)
Dim counter As Integer
For counter = 1 To 35
thisRow.Cells(1, 8 + counter).Value = sourceRow.Cells(1, 19 + counter)
Next counter
End Sub
Where I pass it -
ElseIf bar.Cells(1, 19) = prevComp And bar.Cells(1, 19).Value = foo.Cells(1, 2).Value Then ' compare if prev and current comp match
' add other DTCs of this component
destRange.Cells(1, 1).Value = idNumber
destRange.Cells(1, 2).NumberFormat = "#"
destRange.Cells(1, 2).Value = CStr(objectNumber + dotNumber - 0.01) & "-" & CStr(dashNumber)
destRange.Cells(1, 3).Value = "3"
destRange.Cells(1, 5).Value = bar.Cells(1, 6).Value '
destRange.Cells(1, 6).Value = bar.Cells(1, 10) ' foo.Cells(1, 3).Value & " - " & foo.Cells(1, 4)
destRange.Cells(1, 7).Value = bar.Cells(1, 11)
destRange.Cells(1, 8).Value = "FMI " & bar.Cells(1, 11) & ": " & bar.Cells(1, 13)
LoopThru38 destRange, bar ' loops through rest of 38 col to populate export sheet
Set destRange = destRange.Offset(1, 0)
idNumber = idNumber + 1
dashNumber = dashNumber + 1
End If
Original declarations of the ranges -
With ThisWorkbook
Set WS = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
Set Columns_38 = .Worksheets("Joe")
Set dtcList = .Worksheets("Fred")
Set spnList = .Worksheets("Martha")
End With
'...cont
Set srcRange = dtcList.Range(dtcList.Cells(2, "A"), dtcList.Cells(lastRowSrc, "A"))
Set destRange = WS.Range(WS.Cells(2, 1), WS.Cells(2, 42))
Set spnRange = spnList.Range(spnList.Cells(6, 1), spnList.Cells(lastRowSPN, 1))
spnRange is where I seem to be having issues. It is in the second For loop (bar), and that is where I get the source data for the output. It doesn't want to pass 'bar' into the sub though. Do I need to pass the whole range in there, and figure out where I am at?
Thanks
You need to explicitly declare bar as a Range in the calling loop. If you do not, then it isn't a Range object, but rather a Variant that contains a Range object. This works the same until you try pass it to a function/subroutine argument that is declared ByRef as a specific object-type, like Range.
This will throw an error, because the compiler cannot tell if it really will be a Range type at run-time.
The object type when using a For Each loop on a Range is Range.
Sub DisplayFirstTextInRange(WithinThisRange as Range)
Dim rng As Range
For Each rng in WithinThisRange
If rng.Text <> "" Then
MsgBox rng.Text
Exit Sub
End If
Next rng
End Sub
A more useful way of iterating through ranges may be by Row:
Sub DisplayFirstTextInFirstColumnOfRows(WithinThisRange as Range)
Dim rng As Range
For Each rng in WithinThisRange.Rows
If rng.Cells(1,1).Text <> "" Then
MsgBox rng.Cells(1,1).Text
Exit Sub
End If
Next rng
End Sub