I have a code which works good but i want some modifications as
Value of cell B5 in Sheet "feb" If sheets("Feb").Range("I5:AK81)<>"" (if any of the cell in range is none-blank and Sheets("Jan").Range("I5:AM81") is not equal to "TRF." means if any of the the cell in range is not equal to "TRF." then VLookup cell B5 in sheet "Jan" in range Sheets("master").Range("H7:Q200"),1,0) and copy it and paste in cell B5 of sheet "Feb".
and go to last blank column in range B5:B81 of sheet feb and if any of date in column O of Sheets("master").Range("H7:q200") falls only within current month of current year then copy appropriate cell b in the range and paste in last empty cell of sheet "Feb" range B5:B81 and so on
Below is code
Option Explicit
Sub CopyRows()
Dim Cl As Range
Dim str As String
Dim RowUpdCrnt As Long
str = "WRK.*" 'string to look for
Sheets("Feb").Range("B5:B81").Value = ""
RowUpdCrnt = 5
' In my test data, the "WRK."s are in column AN. This For-Each only selects column AN.
' I assume all my "WRK."s are in a single column. Replace "B" by the appropriate
' column letter for your data.
With Sheets("Jan")
' loop until last row with data in Column AN (and not the entire column) to save time
For Each Cl In .Range("AN1:AN" & .Cells(.Rows.Count, "AN").End(xlUp).Row)
If Cl.Value Like str And Sheets("Feb").Range(Cl.Address).Value <> "" Then
'if the cell contains the correct value copy it to next empty row on sheet 2 & delete the row
If Not IsError(Application.Vlookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)) Then ' <-- verify the VLookup was successful
Sheets("Feb").Range("B" & RowUpdCrnt).Value = Application.Vlookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)
RowUpdCrnt = RowUpdCrnt + 1
End If
End If
Next Cl
End With
Application.CutCopyMode = False
End Sub
If AND(criteria1,critieria2) then
This should allow you a second criteria, and not need to nest another if statement.
Kind of hard to follow the direction you're going, so correct me if this is wrong. Not quite getting the "so on" part of this, but we can try to break down some of this:
.1) then VLookup cell B5 in sheet "Jan" in range Sheets("master").Range("H7:Q200"),1,0)
'You've got this. I would recommend index/match
'using application and worksheet function commands.
.2) copy it and paste in cell B5 of sheet "Feb".
With Sheets("Feb").Range("B5").PasteSpecial xlPasteValues
.3) go to last blank column in range B5:B81 of sheet feb
Dim LR as Long 'LR is last row
LR = Cells(Sheets("Feb").Rows.Count, 1).End(xlUp).Row
.4) if any of date in column O of Sheets("master").Range("H7:q200") falls only within current month of current year
'Assuming this sheet based... Assuming H is the date column
If Sheets("master").Range("H7:H200").Value = "2" Then
.4a) then copy appropriate cell b in the range
'use index/match with output being Column(2)/B
WorksheetFunction.Index(rangeB,WorksheetFunction.Match(reference,rangeH)).Copy
.4b) paste in last empty cell of sheet "Feb" range B5:B81
Sheets("Feb").Cells(LR+1,2).PasteSpecial xlPasteValues
.5) so on
This will hopefully give a start to you. Just think about each line procedurally, if you can.
Related
I'm just starting to use VBA and I would like some help with writing an IF statement that is searching using =ISnumber() as it loops through all of column A until it encounters an empty cell.
The data I am working with is a text file that is being dropped onto sheet1 and has data that only populates column A.
On sheet2 I would like to press a button that starts a loop. The loop needs to check each row of sheet 1 to see what the first three numbers of the line is for example: =ISNUMBER(SEARCH("101",A1)) If this qualification is met then complete something like: =MID(A1,24,6)
There are two different row starts: 101 and 621.
My pseudo code logic is as follows:
Sub Button1_Click()
IF 'first iteration
Row A1 starts with "101"
THEN Add =MID(A1,24,6) to cell A1 of sheet 2
ELSE IF
Row starts with "621"
THEN Add =MID(A1,55,24) to cell B1 of sheet 2
AND add =MID(A1,30,10) to cell C1 of sheet 2
ELSE
Skip this row
End If
IF 'second iteration
Row A2 starts with "101"
THEN Add =MID(A2,24,6) to cell A2 of sheet 2
ELSE IF
Row starts with "621"
THEN Add =MID(A2,55,24) to cell B2 of sheet 2
AND add =MID(A2,30,10) to cell C2 of sheet 2
ELSE
Skip this row
End If
'iterations continue until empty cell
End Sub
You can do it like this - you may have to change sheet names to suit. That said, you don't need VBA for this, you could do it with formulae.
Sub Button1_Click()
Dim r As Range
With Sheet1
For Each r In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
If Left(r, 3) = "101" Then
Sheet2.Range(r.Address).Formula = "=MID(Sheet1!" & r.Address & ",24,6)"
ElseIf Left(r, 3) = "621" Then
Sheet2.Range(r.Offset(, 1).Address).Formula = "=MID(Sheet1!" & r.Address & ",55,24)"
Sheet2.Range(r.Offset(, 2).Address).Formula = "=MID(Sheet1!" & r.Address & ",30,10)"
End If
Next r
End With
End Sub
how to copy & paste the data from one column to another between two sheets of excel workbook ... without overwriting the destination column content?
I am using below code to copy & paste but every time I run it it is overwriting the existed content. I want to be pasted from next row of the column.
Sub DirectCopySample()
Application.ScreenUpdating = False
Sheets("Updating Sheet").Range("A:A").Copy Destination:=Sheets("Sheet1").Range("G:G")
Sheets("Updating Sheet").Range("B:B").Copy Destination:=Sheets("Sheet1").Range("F:F")
Sheets("Updating Sheet").Range("C:C").Copy Destination:=Sheets("Sheet1").Range("B:B")
Application.ScreenUpdating = True
End Sub
Don't copy the entire column. Copy a specific 1-cell-wide range of X rows (where X is your data) and define all your variables based on the current size of the data. For instance if you want to copy column A from sheet1 to the end of column B in sheet2.
Sub CopyColumn()
Dim wsCopy As Worksheet
Set wsCopy = Sheets("<Sheet Name>")
Dim wsPaste As Worksheet
Set wsPaste = sheets("<Sheet Name>")
'/ Much better to make your worksheets variables and then reference those
Dim lngFirstRow As Long
Dim lngFinalRow As Long
Dim lngCopyColumn As Long
Dim lngPasteColumn As Long
Dim rngCopy As Range
Dim rngPasteCell As Range
lngCopyColumn = 1 '/ ("A" Column)
lngDestinationColumn = 2 '/ ("B" Column)
wsCopy.Activate
lngFirstRow = 1
lngFinalRow = Cells(1048576, lngCopyColumn).End(xlUp).Row
'/ Starts at the bottom of the sheet, stops at the first cell with data in it, returns that cell's row
Set rngCopy = Range(Cells(lngFirstRow, lngCopyColumn), Cells(lngFinalRow, lngCopyColumn))
'/ Defines the range between those 2 cells
rngCopy.copy
wsPaste.Activate
lngFinalRow = Cells(1048576, lngPasteColumn).End(xlUp).Row
Set rngpaste = Cells(lngFinalRow + 1, lngPasteColumn)
'/ Pastes to the row 1 cell below the last filed cell in Column B
rngpaste.Paste
End Sub
#Grade 'Eh' Bacon outlined the correct process in his or her comment.
The crux of the issue is finding the size of the ranges you are copying from and pasting to. My current favorite method of doing so is the code snippet below:
copyLastrow = Sheets("Updating Sheet").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
That will find the last non-empty row in your worksheet. So if for some reason column A has 100 rows, B has 200 rows, and C has 300 rows it will return 300 as the last row.
On the paste side of things, you could use the same method and add 1 to it so you paste into the first empty row, but if the columns have different numbers of rows you will end up with many blank rows in the shorter columns before your data is pasted at the bottom.
A work around this is the following code:
pasteLastrowG = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row + 1
This will start at the bottom of column G and head up until it hits a row with data in it and then add 1 so that you are pasting into the first blank row of the column. You could then create variables for columns H and I that do the same thing.
Putting it all together your code would look something like this in the end:
copyLastrow = Sheets("Updating Sheet").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
pasteLastrowG = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row + 1
'pasteLastrowH ...
'pasteLastrowI ...
Sheets("Updating Sheet").Range("A2:A" & copyLastrow).Copy Destination:=Sheets("Sheet1").Range("G" & pasteLastrowG)
'Copy and paste B code here
'Copy and paste C code here
I have an Excel 2010 workbook with 22 worksheets in it. The first worksheet is labeled DATA, where data is entered by a user. Row A1-N1 contain labels. Rows A2-A18 contains data for January 2015 for the 17 locations beginning as cell A2, i.e. row 2 contains data for location 1, row 3 for location 3, etc. February data begins at row 19, March begins at row 36, etc.
On each worksheet A1-M1 are labels and rows 2-13 are the months January - December. Cell B2 on worksheet #2 references cell J2 on the worksheet DATA. The other formulas on row 2 of worksheet #2 reference cells on row 2 on worksheet DATA. Row 3 of worksheet #2 references cells on row 19 of DATA. In column N of each location worksheet has a number in cell N2 that corresponds to the appliable row on the worksheet DATA.
Here is an example of one of my formulas:
=(IF(ISBLANK(DATA!D2),"-",IF(ISERROR(DATA!E2/DATA!D2),"N/A",(DATA!E2/DATA!D2)))).
I would like to have VB code, or a macro?, that would edit every formula on each worksheet by replacing the current number in the formula with the number in column N of that same row, i.e. if N7 contained the number 88 the code would alter any formula on that row by removing the current number in the formula and replacing with the number 88.
Additional information:
On each worksheet there are different formulas for columns B-M. The code would need to take the number in column N for that row and replace whatever number is in that formula with the number in column N of that row, for each row, for each worksheet.
Currently, I have to touch each formula on every worksheet and this is too time consuming. Beginning in April the locations will increase from 17 to 148 which will require coding to make the appropriate changes.
DATA worksheet image
1R location worksheet image
I am not on my work computer, so I haven't had the opportunity to test out this code, but I believe this should do what you want. If there are any issues with it, let me know, and I'll have a look at it at work tomorrow.
Sub replace_numbers()
Dim ws As Worksheet
Dim c As Range
Dim replace_with As Long
Dim objRegex As Object
'Application.EnableEvents = False
'Application.ScreenUpdating = False
'Application.DisplayStatusBar = False
'Application.Calculation = xlCalculationManual
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "\d+"
End With
For Each ws In Worksheets
If ws.Name <> "DATA" Then
For Each c In ws.Range("B2:M13")
replace_with = CLng(Intersect(ws.Columns("N"), ws.Rows(c.Row)).Value)
c.Formula = objRegex.Replace(c.Formula, replace_with)
Next
End If
Next
'Application.EnableEvents = True
'Application.ScreenUpdating = True
'Application.DisplayStatusBar = True
'Application.Calculation = xlCalculationAutomatic
End Sub
If the code runs as intended, remove the apostrophes before the Application-calls, in order to make the code run somewhat faster.
You can always use something like:
If IsEmpty(Worksheets("DATA").Cells(2, 4)) And _
IsError(Worksheets("DATA").Cells(2, 5).Value / Worksheets("DATA").Cells(2, 4).Value) Then
ActiveCell = "NA"
Else
ActiveCell = Worksheets("DATA").Cells(2, 5).Value / Worksheets("DATA").Cells(2, 4).Value
End If
Which is the formula you have translated to VBA code.
However, you must add error handlers, and other stuff according to what you have in your input data.
I have been using simple excel array formulas to count certain values on a master sheet but now at the point where I have too many formulas in my document and excel is crashing.
Therefore, I would like to create a macro that can do the same task. I would like to have the code do the following:
IF the activecell in Sheet1 matches to any cell in a column(or range) in Sheet2,
AND IF the cell in the same row in an adjacent column in Sheet2 is not blank,
THEN count all the instances that specific string appears in Sheet2 column A
AND place the value 2 columns to the right of the original active cell in Sheet1.
Here is the original array formula I was using:
=SUM(IF(Sheet1!$A8=Sheet2!$A:$A,IF(SalesF_SignUp_data!$C:$C>1,1,0)))
The formula above is taking the cell A8 in Sheet1 and checking if it matches to any cell in Sheet2 column A,
AND making sure that column C in Sheet2 is not blank in the same row.
If this is TRUE then "add 1" for all the instances
AND place that value in Sheet1.
I believe the best way to do this is a For Next Loop but haven't been able to execute any successful code based on examples I've found.
Im happy to explain further if needed. Since I dont have a reputation of 10 I cant attach images but am willing to send if needed.
This is set up to run for all the cells you've selected in column A of sheet 1.
It looks in Sheet2 column A for the value on Sheet1 column A, then in Sheet1 column B, displays how many times the value appeared in Sheet2 column A along with a value in the same row of column C.
If the answer is helpful, please mark it as such. :-)
Option Explicit
Sub countinstances()
Dim result, counter, loopcount, tocomplete, completed As Integer
Dim findtext As Variant
Dim cell, foundcell, nextcell As Range
'Checks to make sure the sub isn't accidentally run on an invalid range
If ActiveSheet.Name <> "Sheet1" Or ActiveCell.Column <> 1 Or Selection.Columns.Count > 1 Then
MsgBox ("Please select a range in column A of Sheet 1.")
Exit Sub
End If
'In case of selecting the entire column A, curtail the number of blank cells it runs on.
tocomplete = Application.WorksheetFunction.CountA(Selection)
completed = 0
'For each cell in the selected range, searches Sheet2, Column A for the value in the selected cell
For Each cell In Selection
If completed = tocomplete Then Exit Sub
If cell.Value <> "" Then completed = completed + 1
findtext = cell.Value
result = 0
Set foundcell = Sheets("Sheet2").Range("A1")
'Uses the count function to determine how many instances of the target value to search for and check
loopcount = Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), findtext)
'Skips the loop if the target value doesn't exist in column A
If loopcount = 0 Then GoTo NotFound
'For each time the target value was found, check the cell in column C. If it's not blank, increment "result"
For counter = 1 To loopcount
Set nextcell = Sheets("Sheet2").Range("A:A").Find(what:=findtext, lookat:=xlWhole, after:=foundcell)
If nextcell.Offset(0, 2).Value <> "" Then
result = result + 1
End If
Set foundcell = nextcell
Next
'Put the result in column B of Sheet1
NotFound:
cell.Offset(0, 1).Value = result
Blanks:
Next
End Sub
I don't know how to write a macro that designates a cell within a column as a "master cell" (editable) copy that cells value to all the cells below it in that column, until it reaches a blank/clear formatted cell in column A. So I want it to look at column A to know when to stop copying the cell values in whichever column.
That is, Cell "C5" will be a master cell, the macro will copy it's value from "C6:C" but looking at column A's cell values to see if it has nothing in it and there's no formatting such as color fill, etc. and instead of the macro continuing on in column C to infinity (maximum increment for Excel) it will stop at A column's first blank cell row.
Sub Example()
Dim MasterValue As String
Dim StopRow As Long
Dim i As Long
'Get the master value
MasterValue = Range("C5").Value
'Get the first blank cell in column A
StopRow = Range("A1").End(xlDown).Row
'Start at row 6 and continue to the "Stop Row"
For i = 6 To StopRow
'Set every cell from row 6 in column 3 to the "Master Value"
Cells(i, 3).Value = MasterValue
Next
End Sub