I have got a macro that needs to loop according to the number of columns that exist in the Worksheet "NSA" (not counting the dates), as in the image below:
Looping through the columns, the macro needs to fill the corresponding range in the worksheet "SA" with a random number, one column at a time.
I want to fill one column of "SA" for each time the loop occurs in "NSA", as to keep different numbers in B:B and C:C.
Thus, in the first time the code runs, I would like to insert data only in column B and, in the second time, fill only the column C.
That's where my code fails. It always fills both columns B and C in the worksheet "SA" at the same time, each time it runs. This is what I get (for a random value):
How could I change the loop so the columns in "SA" change only one at a time, according to the loop in "NSA"?
Thanks for the help.
Here is my code:
Sub Dessaz2()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
Dim wsNSA As Worksheet
Set wsNSA = wb1.Worksheets("NSA")
Dim wsSA As Worksheet
Set wsSA = wb1.Worksheets("SA")
Dim col1 As Range
Dim col2 As Range
LR = wsNSA.Cells(3, 1).End(xlDown).Row
LC = wsNSA.Cells(3, 1).End(xlToRight).Column
For Each col1 In wsNSA.Range(Cells(3, 2), Cells(LR, LC)).Columns
wsNSA.Activate
wsSA.Activate
x = WorksheetFunction.RandBetween(0, 100)
wsSA.Range(Cells(3, 2), Cells(LR, LC)) = x
Next
End Sub
Fill col1.column each time :
Sub Dessaz2()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
Dim wsNSA As Worksheet
Set wsNSA = wb1.Worksheets("NSA")
Dim wsSA As Worksheet
Set wsSA = wb1.Worksheets("SA")
Dim col1 As Range
Dim col2 As Range
LR = wsNSA.Cells(3, 1).End(xlDown).Row
LC = wsNSA.Cells(3, 1).End(xlToRight).Column
For Each col1 In wsNSA.Range(wsNSA.Cells(3, 2), wsNSA.Cells(LR, LC)).Columns
wsNSA.Activate
wsSA.Activate
x = WorksheetFunction.RandBetween(0, 100)
wsSA.Range(wsSA.Cells(3, col1.Column), wsSA.Cells(LR, col1.Column)) = x
Next
End Sub
Sub Main()
Dim rng as Range, cl as Range
Set rng = worksheets("NSA").Range("B1:C100") // update for your Range
For each cl in rng
Worksheets("SA").Range(cl.Address) = WorksheetFunction.RandBetween(0, 100)
Next cl
End Sub
Related
I have a noncontiguous range and I want whatever the user writes in each cell in the range to show up in a column in a table I made. In the first column of my table I'm having the program number each generated entry in the table when the user adds a value in one of the specified cells all the way up to 18. I renamed each cell in the range to be "Space_ (some number)". Even though I have written in three of the specified cells, my table only shows me the first value in the first specified cell.
Here is my code so far:
Sub test2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Integer
Dim rng As Range
Set rng = ws.Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")
ws.Range("A13:A31,B13:B31").ClearContents
For i = 1 To 18
If Not IsEmpty("rng") Then
ws.Range("A12").Offset(1).Value = i
End If
Exit For
Next i
If Not IsEmpty("rng") Then
ws.Range("B12").Offset(1).Value = rng.Value
End If
End Sub
This should address the various issues I mentioned in my comment:
Sub test2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Long
Dim rng As Range, r As Range
With ws
Set rng = .Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")
.Range("A13:B31").ClearContents
For Each r In rng.Areas
If Not IsEmpty(r) Then
.Range("A13").Offset(i).Value = i + 1
.Range("B13").Offset(i).Value = r.Value
i = i + 1
End If
Next r
End With
End Sub
A couple things here - Instead of trying to put all your named ranges into a Range, put them individually in an Array and cycle through them - If they're not blank, put the value into the cell.
Your .Offset is always going 1 below row 12, so that's why you're only seeing one row of data.
Sub test2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Long, j As Long
Dim rngarray As Variant
rngarray = Array("Space_7", "Space_10", "Space_13", "Space_16", "Space_19", "Space_22", "Space_25", "Space_28", "Space_31", "Space_34", "Space_37", "Space_40", "Space_53", "Space_56", "Space_59", "Space_62", "Space_65", "Space_68")
j = 12
ws.Range("A13:B31").ClearContents
For i = 0 To UBound(rngarray)
If ws.Range(rngarray(i)).Value <> "" Then
ws.Range("A12").Offset(j - 11).Value = i + 1
ws.Range("B12").Offset(j - 11).Value = ws.Range(rngarray(i)).Value
j = j + 1
End If
Next i
End Sub
I'd go as follows:
Sub test2()
Dim i As Integer
Dim rng As Range, cell As Range
With ThisWorkbook.Sheets("Sheet1")
.Range("A13:A31,B13:B31").ClearContents
Set rng = .Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")
For Each cell In rng.SpecialCells(xlCellTypeConstants).Areas
ws.Range("A12:B12").Offset(i).Value = Array(i + 1, cell(1, 1).Value)
i = i + 1
Next
End With
End Sub
Dim count As Integer
Dim myData As Workbook
Dim col As Range, rng As Range, n#, b#
Set col = Columns(1) 'choose the column to count the values from
SetmyData=Workbooks.Open("C:\Users\xyz\Desktop\cas\Book3.xlsx")'selecting a workbook'
Worksheets("sheet1").Select
Set rng = Intersect(col, ActiveSheet.UsedRange)
On Error Resume Next
b = rng.Cells.SpecialCells(xlCellTypeBlanks).count'applying the count function'
n = rng.Cells.count - b - 1
On Error GoTo 0
Worksheets("sheet1").Select
count = n
Set myData = Workbooks.Open("C:\Users\xyz\Desktop\cas\Book2.xlsx")'used to update the data in another workbook
Worksheets("sheet1").Select
I am not able to select the workbook to apply count algo.
run time error- application defined or object defined error
The code below will get you the count of the None-Empty cells in Column "A" in "sheet1" in myData Workbook.
You can avoid all the unnecessary Select, which slows down your code run-time.
Also, you can use the WorksheetFunction.CountA function to count the number of cells in a range that are not empty.
Code
Option Explicit
Sub CountNonEmptyCells()
Dim MyCount As Long
Dim myData As Workbook
Dim Rng As Range
Set myData = Workbooks.Open("C:\Users\xyz\Desktop\cas\Book3.xlsx") ' selecting a workbook'
With myData.Worksheets("sheet1")
Set Rng = Intersect(.Columns(1), .UsedRange)
MyCount = WorksheetFunction.CountA(Rng)
End With
End Sub
what I am trying to do is fairly straight forward:
Select any range of cell in WorkBook A (with value in it)
Look up every single value in that selected range from an (two columns) array in WorkBook B (say A1:B10000)
Return the value from the 2nd column of the array to Workbook B back to WorkBook A to the columns immediately to the right next to the range selected in step 1.
Here is the code I have been working so far.
Sub Checker()
Dim rw As Long, x As Range
Dim extwbk As Workbook, twb As Workbook
Dim SelRange As Range
Set twb = ThisWorkbook
Set SelRange = Selection
Set extwbk = Workbooks.Open("path to the file in my harddrive")
Set x = extwbk.Worksheets("Sheet1").Range("A1:B100000")
With twb.ActiveSheet
For rw = Selection.Row To Selection.Rows.Count + rw - 1
.Cells(rw, Selection.Column + 1) = Application.VLookup(.Cells(rw, Selection.Column).Value2, x, 2, False)
Next rw
End With
Somewhere in the section part of the code something is wrong but I cannot really figure it out. Could any of you folks help?
My macro goes through a range, looping by columns, finds where the numeric data starts in each column and stores the ranges in a jagged array (the "matrix" variant in the code).
After that, I would like to return the entire matrix to a range in another worksheet. If I try to assign "matrix(1)" to the range where I want it to be put, it works fine, but if I try to assign the entire "matrix" to a range, I get blank cells.
How could I return all of the values in "matrix" to a range at once, without using loops?
This is the source data, through which the code loops:
I would like that all of the rows of "matrix" would be returned as this:
Here is my code:
Sub MyMatrix()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
Dim wsNSA As Worksheet
Set wsNSA = wb1.Worksheets("NSA")
Dim wsSA As Worksheet
Set wsSA = wb1.Worksheets("SA")
Dim col As Range
Dim matrix() As Variant
'LR is the Last row and LC is the last column with data
LR = wsNSA.Cells(1, 1).End(xlDown).Row
LC = wsNSA.Cells(LR, 1).End(xlToRight).Column
'Loops through columns and finds the row where numeric data begins
For Each col In wsNSA.Range(wsNSA.Cells(1, 2), wsNSA.Cells(LR, LC)).Columns
wsNSA.Activate
nsa = wsNSA.Range(wsNSA.Cells(1, col.Column), wsNSA.Cells(LR, col.Column))
num_linha = Application.Match(True, Application.Index(Application.IsNumber(nsa), 0), 0)
nsa = wsNSA.Range(wsNSA.Cells(num_linha, col.Column), wsNSA.Cells(LR, col.Column))
'The range starts in the column B in the worksheet, so the matrix ubound is 'col.column -1
ReDim Preserve matrix(1 To col.Column - 1)
matrix(col.Column - 1) = nsa
Next
wsSA.Range(wsSA.Cells(3, 2), wsSA.Cells(LR, LC)) = matrix
End Sub
You can just copy all and delete the blank cells after:
Sheet1.Range("A3").CurrentRegion.Copy Destination:= Sheet2.Range("A3")
Sheet2.Range("A3").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
If you are you willing to forget the requirement that the output should not be written inside a loop, the following code would probably do what you are trying to do:
Sub MyMatrix()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
Dim wsNSA As Worksheet
Set wsNSA = wb1.Worksheets("NSA")
Dim wsSA As Worksheet
Set wsSA = wb1.Worksheets("SA")
Dim c As Long
Dim LC As Long
Dim LR As Long
Dim num_linha As Long
Dim nsa As Variant
With wsNSA
'LR is the Last row and LC is the last column with data
'???? Is data1_linha declared anywhere and assigned a value? ????
LR = .Cells(data1_linha, 1).End(xlDown).Row
LC = .Cells(LR, 1).End(xlToRight).Column
'Loops through columns and finds the row where numeric data begins
For c = 2 To LC
nsa = .Range(.Cells(1, c), .Cells(LR, c))
num_linha = Application.Match(True, Application.Index(Application.IsNumber(nsa), 0), 0)
wsSA.Cells(3, c).Resize(LR - num_linha + 1, 1).Value = .Range(.Cells(num_linha, c), .Cells(LR, c)).Value
Next
End With
End Sub
I have a table with two rows : the first row contains the locations where the value of the second row should be pasted.
For example :
row 1 : sheet8!D2 sheet6!D2 sheet2!C5
row 2 : apple lemon pEER
So apple should be pasted in sheet 8 cell D8. Lemon should be pasted in sheet6 cell D2. The problem is that the value apple is pasted everywhere (in sheet8!D2, sheet6!D2 and sheet2!C5). How can I correct this?
Sub Sample()
Dim rng As Range
Dim Sh As String, Cl As String
Dim ws As Worksheet
Dim i As Integer
Dim Row1 As String
ncol = Range("A1:F1").Columns.Count
For i = 1 To ncol
Row1 = Range("A1:F1").Cells(1, i).Value
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
Sh = Split(Row1, "!")(0)
Cl = Split(Row1, "!")(1)
Set rng = ThisWorkbook.Sheets(Sh).Range(Cl)
rng.Value = .Range("A2").Value
End With
Next i
End Sub
There are a few issues with your code. First up its good practice to put Option Explicit at the top of each module, this will ensure variables are defined (ncol is not defined).
The following code will fix the problem although it could be tweaked in various ways. The main problem is you don't quite set the referencing ranges correctly, you move through the columns with your loop but always refer back to cell A2. Assuming your input data is on rows 1 and 2 and run from the sheet with that data this will work.
Sub SampleFixed()
Dim rng As Range
Dim Sh As String, Cl As String
Dim ws As Worksheet
Dim i As Integer, ncol As Integer
Dim Row1 As String
ncol = Range("A1:F1").Columns.Count
For i = 1 To ncol
Set ws = ActiveSheet
With ws
Row1 = .Cells(1, i).Value
If Len(Row1) > 0 Then
Sh = Split(Row1, "!")(0)
Cl = Split(Row1, "!")(1)
Set rng = ThisWorkbook.Sheets(Sh).Range(Cl)
'Here you were always refering to cell A2 not moving through the values which was the main problem.
rng.Value = .Cells(2, i).Value
End If
End With
Next i
End Sub