VBA - Dynamic Copy&Past of a Range - vba

Can't find the correct syntax for the dynamic range, please help.
On 'Sheet1' I have a source table range "B2:F50"
For each row in that table need to test certain condition
If condition is met THEN copy that table line to a new position,
on 'Sheet1' Example:
FOR I = 1 TO 50 ' I for each Row)
IF certain cell = x THEN
'copy that table line entries (not entire row) to a new position
Range(source I, source-Col).Copy (target I, target-Col)
END IF
NEXT I
Basically creating a new table (On same rows, shifted columns) but with only entries
that meet the condition. Don't want to copy entire rows.
Many thanks
Sam

I believe something along these lines should sort out your problem:
Set dataWS = ThisWorkbook.Sheets("Sheet1")
For i = 2 to 50
If dataWS.Cells(i,1).value = x Then
dataWS.Range(dataWS.Cells(i, 2), dataWS.Cells(i, 5)).Copy Destination:=dataWS.Range(dataWS.Cells(i, 12), dataWS.Cells(i, 15))
End If
Next i

Related

Trying to create a macro to perform 100 iterations and paste resulting values (2 adjacent row cells) to a 2 x 100 array

I have a worksheet that uses randomly generated numbers in calculations to produce results in two adjacent cells (let's say A1 and A2). I am trying to perform 100 iterations where I'm simply "Calculating Formulas" on the worksheet and then trying to store the results of each iteration next to A1 and A2 (so iteration 1 would be in B1 and B2 and iteration 100 would be in CW1 and CW2). Thanks in advance for your help. Using Excel 2010 if that matters.
Dim Iteration As Integer, i As Integer
Dim val As Variant
Iteration = 100
For i = 1 To Iteration
Calculate
Range("A1:A2").Select
Selection.Copy
Range("B" & Rows.Count).End(x1Up).Offset(0, 1).PasteSpecial
Paste:=xlPasteValues
Next i
End Sub
I think your major problem was with the location you were selecting for the destination address - you were finding the last unused cell in column B, then shifting over one column (i.e. to column C) and pasting the first set of results. Then you were using that same location for the second set of results, etc.
Sub Test()
Dim Iteration As Integer, i As Integer
Dim val As Variant
Iteration = 100
'Use a "With" block so that it can be easily changed in the future
'to refer to a specific sheet if needed
With ActiveSheet
For i = 1 To Iteration
Calculate
'Determine the last used column on row 1,
' offset 1 column to the right,
' resize to refer to 2 rows,
' set values to the values in A1:A2
.Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).Resize(2, 1).Value = .Range("A1:A2").Value
Next i
End With
End Sub
As pointed out by Steve Lovell, you also had a typo in your original code. It is a good habit to include Option Explicit as the first line in every code module. That will force you to declare all the variables that you use, and the compiler would have highlighted x1Up and given a "Variable not defined" error.

Inserting text to blank row using vba macro in excel

I have a data of say more than 5000 rows and 10 columns. I would like to add a text to the rows based on columns conditions.
A B C D
fname lname state clustername
1. ram giri NCE ...
2. philips sohia MAD ...
3. harish Gabari NCE ....
Based on the column state, for NCE the cluster name is "nce.net" has to be assigned to column D (clustername) and also for MAD is "muc.net" to be assigned to row 2.
could you please help me out.
Here is my code:
dim emptyrow as string
row_number = 1
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
state = sheets("sheet1").rows("C" & row_number)
for each cell in selection
if instr(state, "NCE") = true then
Range(Cells(emptyrow, "D").Value = Array("nce.net")
end if
next emptyrow
Could you please help me out.
Why not a simple formula
In D1 and copy down
=IF(C1="NCE","nce.net",IF(C1="MAD","muc.net","No match"))
Doing the same this with code
Sub Simple()
Dim rng1 As Range
Set rng1 = Range([c1], Cells(Rows.Count, "C").End(xlUp))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=IF(RC[-1]=""NCE"",""nce.net"",IF(RC[-1]=""MAD"",""muc.net"",""No match""))"
.Value = .Value
End With
End Sub
You may create a reference table consisting of unique state and clustername in a seperate worksheet and then pull the clustername into your original sheet using a =VLOOKUP() function ... provided there is a 1:1 relation between state and cluster ... even 1 cluster for multiple states would work. This way you avoid hardcoding and you can react quickly if cluster names change.
Example:
in Sheet2 list all countries and their associated clusternames
in Sheet1 enter =VLOOKUP(...) into first row of clustername column as per below picture and copy down for all rows
Of course you may want to have values only, not formulas in your cluster column; then you can convert formulas into values by copying and then pasting as values that cluster column after you've entered the =VLOOKUP(...) formula.
Alternatively, if e.g. you have a lot of clusternames already defined and only want to work on rows where clustername is blank, you can
filter for blank clusternames and insert the =VLOOKUP(...) only there
use a small piece of code
Sub DoCluster()
Dim R As Range, S As Integer, C As Integer, Idx As Integer
Set R = ActiveSheet.[A2] ' top left cell of table
S = 3 ' column index of State column
C = 4 ' column index of Clustername column
Idx = 1 ' start at 1st row within range
' run a loop across all rows, stop if 1st column gets blank
Do While R(Idx, 1) <> ""
' work only on rows wher cluster not yet set
If R(Idx, C) = "" Then
' now this isn't really good ... try to avoid hardcoding BY ANY MEANS
Select Case R(Idx, 3)
Case "NCE"
R(Idx, 4) = "nce.net"
Case "MAD"
R(Idx, 4) = "muc.net"
' insert other cases here as per need
' ...
' trap undefined cases
Case Else
R(Idx, 4) = "undefined"
End Select
End If
Idx = Idx + 1
Loop
End Sub
Personally I don't like this kind of hardcoding at all, I'd rather take the clusternames from a table ... so for me there wouldn't be a need to write code unless the whole task is much more complex than described.

VBA Excel word search and copying formulas

I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.

Excel: Copy-paste rows in between sheets depending on multiple criteria

Thank you for the comments so far, it has helped me formulate my question better/differently.
I have two sheets, Sheet1 and Sheet2.
Sheet1 contains ~100,000 rows with 5 columns and Sheet2 should contain a subgroup of Sheet1, depending if the rows in Sheet1 contain certain values in certain columns.
This is the code I have so far. Somehow the VBA doesn't give me any error, but the code also doesn't run, which makes it difficult to find a possible solution. Anyone any ideas?
Sub CopyRows()
Dim r As Integer
Dim cell As Range
r = 2
For Each cell In Selection
If Application.WorksheetFunction.IsNA(Sheets("Sheet1").Cells(r, 1)) = False Then
If Sheets("Sheet1").Cells(r, 3) = "Product1" or "Product2" Then
If Sheets("Sheet1").Cells(r, 5) = "2011" or "2012" Then
If Sheets("Sheet1").Cells(r, 4) > 0 Then
cell.EntireRow.Copy Destination:=activesheet.Rows(r)
r = r + 1
End If
End If
End If
End If
Next cell
End Sub
For such consolidations my first bet would be a Pivot table; in your case
Company & City at the vertical
product at the horizontal (if not too many)
count or sum of value inside
plus eventually a filter to exclude empty key fields.
If you arrange your sheet1 so that there is only one header line in row 1, you can select entire columns (say $A:$D) as pivot table input range, and any additional rows will be included in the Pivot upon refresh.
Of course, the Pivot table can be sorted, filtered, subtotaled etc. etc.

Move data from every X column into single column in Excel

Problem Solved using modifications to answer
Dim i As Long, values As Range, current As Range
Set current = Range("D4") '//select 1st anchor cell
Do Until current.Value = ""
i = i + 45
Set values = Range(current.Offset(2, 0), current.Offset(45, 0)) '//select all in the ooc column
values.Copy '//got block of data here
Sheets("Sheet1").Range("A" & i).PasteSpecial
Set current = current.Offset(0, 13) '//next page
Loop
Starting in column C of an excel spreadsheet, I have pages of data 13 columns wide. I need to transfer the data in the 2nd and 3rd columns to a SQL Database, so I'm trying to move those 2 columns on each page on top of eachother for transfer.
The Screenshot below is the data im working with. I need to capture server names under ODC CSS Servers RowX CabX along with its corresponding asset tag. If i can just take those 2 columns every 13 rows and stack them I can delete the extra information on my own.
Spreadsheet http://img830.imageshack.us/img830/6126/unledoks.png
I'm sure I don't need to mention the insane amount of time this would save but I could really use some help getting started with, or using an example macro to accomplish this. I don't have much for VBA experience unfortunately, but I will work with what help I can get.
What about;
dim i As Long, values as range, current As range
set current = Range("D4") '//select 1st anchor cell
do until current.Value = ""
i = i + 1
set values = range(current.offset(1, 0), current.End(xlToRight)) '//select all in the ooc column
values.copy '//got block of data here
sheets("someothersheet").range("A" & i * 2 - 1).pastespecial
set current = current.offset(0, 13) '//next page
loop