I'm using microsoft excel 2013.
So i have two sheets. "Cases" and "Summarize". All of my important info is on the Cases sheet. Is there way i can be on the "Summarize" sheet, push a button and copy all the cellrows with the value "RLH" from cases over to the summarize sheet?
I've filled the entire row up to N. And i want that entire row to be copied into the summarize sheet when I push the button. The "RLH" value is on the N(last) column.
I know how to create the button and how to insert the code. I've been googling my ass of, but I cant seem to find anything that fits me.
All help is greatly appreciated.
Here is very simple. that will get you started
assign to Button
Option Explicit
Sub Mybutton()
'// declare a variable
Dim cRng As Range
Dim rngA As Long
Dim rngB As Long
Dim Cols As Long
Dim sCases As Worksheet
Dim sSummarize As Worksheet
'// Set the sheets name
Set sCases = Sheets("Cases")
Set sSummarize = Sheets("Summarize")
'// goes through each cell in Sheets"Cases"
'// and copes the Value "RLH" to Sheets"Summarize"
'// it starts from last row in column A & looks up
rngA = sCases.Cells(Rows.Count, "N").End(xlUp).Row
Cols = sCases.UsedRange.Columns.Count
For Each cRng In sCases.Range("A2:A" & rngA)
If cRng.Value = "RLH" Then '<<<<<<<<< Value = "RLT"
rngB = sSummarize.Cells(Rows.Count, "A").End(xlUp).Row + 1
sSummarize.Range("A" & rngB).Resize(1, Cols) = cRng.Resize(1, Cols).Value
End If
'// loop
Next cRng
Set sSummarize = Nothing
Set sCases = Nothing
End Sub
hope this helps
you may also find help full on the following link MSDN Getting Started with VBA.
Related
I am writing a VBA macro where I have an InputBox come up, the user will select a range which will be a full column, and then the macro will paste that range in a particular place on another worksheet. I have been trying to make this code work, but I keep getting different errors depending on what I try to fix, so I was wondering if someone could help me out. I have pasted the relevant parts of the code:
Sub Create_CONV_Files()
Dim NewCode As Range
Set NewCode = Application.InputBox(Prompt:="Select the column with the code numbers", Title:="New Event Selector", Type:=8)
Dim RawData As Worksheet
Set RawData = ActiveSheet
Dim OffSht As Worksheet
Set OffSht = Sheets.Add(After:=Sheets(Sheets.Count))
OffSht.Name = "offset.sac"
Worksheets(RawData).Range(NewCode).Copy _
Destination:=OffSht.Range("A:A")
End Sub
I have tried making the input a string instead, but I am also getting errors there and am not sure how to fix that. I was hoping to use roughly the method I have outlined as my full code has multiple destination sheets and ranges.
Thank you very much for any help you can offer!
once you have set a Range object it brings with it its worksheet property so there's no need to qualify its worksheet
Sub Create_CONV_Files()
Dim NewCode As Range
Set NewCode = Application.InputBox(prompt:="Select the column with the code numbers", title:="New Event Selector", Type:=8)
Dim OffSht As Worksheet
Set OffSht = Sheets.Add(After:=Sheets(Sheets.count))
OffSht.Name = "offset.sac"
NewCode.Copy _
Destination:=OffSht.Range("A1")
End Sub
I am attempting to Copy values in a Row, one by one from each cell, then use those values as worksheet names, one by one. One of the issues I had was skipping the first batch of sheets, so I attempted to hide the ones I don't want renamed. All other sheets should be renamed (34 of them).
I can get it all the way "ws.PasteSpecial xlPasteValues" using F8 before I get an error message that says "Run-time error '1004'L Method 'PasteSpecial' of object'_Worksheet' failed.
I have also tried using "Activesheet.PasteSpecial xlPasteValues" but it gave the same error.
Any suggestions at all are very much appreciated, this is driving me nuts. :) My back up plan is simply using the macro record and doing every rename manually, but it's not a very elegant or simple code that way, so I'd prefer not to do that.
Here is the Code:
Dim ws As Worksheet
Dim TitleID As String
Dim TID As String
Sheets("SheetName1").Activate
Set ws = ActiveSheet
Dim rng As Range, cell As Range
Set rng = ws.Range("C5", "AJ5")
For Each cell In rng
cell.Copy
Sheets("SheetName1").Visible = False
ws.Next.Select
ws.PasteSpecial xlPasteValues
Next cell
If I understand your question, properly, the below code should work.
Dim ws As Worksheet
Set ws = Sheets("SheetName1")
Dim rng As Range, cell As Range
Set rng = ws.Range("C5","AJ5")
Dim i as Integer
i = 5 'this is an arbitrary number, change to whatever number of worksheets
'you wish to exclude that are at the beginning (left most side) of your workbook
'also assumes "SheetName1" is before this number.
For Each cell In rng
Sheets(i).Name = cell.Value
i = i + 1
Next cell
I am very new to VBA and there is a task I would like to automate and don't know where to start. I have a data set that looks like below.
Sample Data
What I'm trying to do is loop through column A and if it has something in it (will always be an email) select all rows until there is something in column A again. Copy and paste into new tab. So row 2-5 would copy and paste into a new tab. Then row 6-9 into a different new tab. Also row 1 would copy to each tab as well. I haven't been able to find code to help with this specific need and any help would be greatly appreciated.
I found this code and started modifying it but, it's nowhere close to what I need or working for that matter.
Sub split()
Dim rng As Range
Dim row As Range
Set rng = Range("A:A")
For Each row In rng
'test if cell is empty
If row.Value <> "" Then
'write to adjacent cell
row.Select
row.Copy
Worksheets("Sheet2").Activate
Range("A2").Select
row.PasteSpecial
Worksheets("Sheet1").Activate
End If
Next
End Sub
This code should provide what you need:
Sub Split()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Worksheets(1) 'change sheet index or use Worksheets("Sheet1") method to use exact name
Dim rngBegin As Range
Dim rngEnd As Range
With ws
Dim rngHeader As Range
Set rngHeader = .Range("A1:H1") 'to copy headers over each time
Dim lRowFinal As Long
lRowFinal = .Range("C" & .Rows.Count).End(xlUp).Row 'assumes eventually last row of needed data will have an address1
Set rngEnd = .Range("A1") ' to begin loop
Set rngBegin = rngEnd.End(xlDown) 'to begin loop
Do
Set rngEnd = rngBegin.End(xlDown).Offset(-1)
Dim wsNew As Worksheet
Set wsNew = Worksheets.Add(After:=wb.Sheets(.Index))'always after current sheet, change as needed
.Range(.Cells(rngBegin.Row, 1), .Cells(rngEnd.Row, 8)).Copy wsNew.Range("A2")
wsNew.Range("A1:H1").Value = rngHeader.Value
Set rngBegin = rngEnd.End(xlDown)
Loop Until rngBegin.Row >= lRowFinal
End With
End Sub
Try to break your process into steps and determine rules on how to proceed. Then write out some pseudo-code (code like logic) to make sure it all makes sense.
You need some sort of loop, since you are going to treat each
group of rows in the same way.
You need some code that determines what cells are contained in each block
Code to take a block (given by step 2) and paste it into a new tab.
Your Pseudo Code might look like this:
' This is the main function that runs the whole routine
Sub Main()
Set headerRg = GetHeaderRg()
Do Until IsAtTheEnd(startRow) = True
Set oneBlock = GetNextBlock(startRow)
Call ProcessBlock(oneBlock)
startRow = startRow + oneBlock.Rows.Count
Loop
End Sub
' This function returns the header range to insert into the top
Function GetHeaderRg() As Range
' Write some code here that returns the header range
End Function
' This function determines whether we are at the end of our data
Function IsAtTheEnd(current_row as Long) as Boolean
' Write some code here that determines whether we have hit the end of our data
'(probably checks the first column to see if there is data)
End Function
' This function takes the startRow of a block and returns the whole block of Rows
Function GetNextBlock(startRow) As Range
' Write some code that returns the whole range you want to copy
End Function
' This sub takes a range to be processed and a header to print and prints
' it into a new tab
Sub ProcessBlock(BlockRg As Range, headerRg as Range)
Set targetSheet = thisWorkbook.Sheets.Add()
' Write some code that pastes the headerRg and BlockRg where you want it
End Sub
If you start to have more specific questions about syntax etc, we will be happy to help here!
I have a very complex workbook with many tabs. The tabs may have either normal data or formulas in various cells. In the case of formulas, the formulas may be nested from one sheet to the next (i.e. a formula on sheet1 refers to a formula on sheet2 which in turn refers to a formula on sheet3, etc.).
I have a hidden tab that contains the following: source sheet, source range, target sheet, and target range.
A named range has been created over these 4 fields and all applicable rows.
When we wish to save data to the database, we loop through every row in the range mapping and copy the data from the source sheet/range to the target sheet/range. After this, the applicable data is serialized into XML and sent to a web service to be saved.
The problem that we wish to resolve is that we want to mark a cell on a hidden sheet when a change is made by the user to a source range. Since formulas can be nested, the Worksheet_Change event does not pick up the change.
Since a change on one sheet may affect another sheet that is not the active sheet, the Workbook_SheetChange event does not catch the change either.
Is there any way form me to catch when a sheet defined in the mapping is changed, even if it is the result of a formula change several levels deep?
Edit
Thank you for your responses. I was attempting to find the fastest and least process intensive way to determine if data changes within a monitored range. The data may consist of actual data or of nested formulas.
My research showed that I could not actually achieve this result by taking range intersections as I could not detect if the data within a monitored range was modified. This is due to the fact that the monitored range may not be on the active sheet and also may contain formulas.
I have shown the method used to actually detect a change below. If there is any feedback on a better way to achieve the same result, I would appreciated it.
Worksheet_Change event will not work if a cell value is changed by a formula, you need Worksheet_Calculate.
Check out my example workbook here.
And Here for the WebPage of example codes
There is no "easy" way to detect if a nested formula has changed when the formula being monitored is not on the active sheet. While my hope was to detect the modified range and use an intersection of ranges to set a flag, this was not possible because the Worksheet_Change event does not work on formulas and the Workbook_SheetChange event only works on the active sheet. Since my workbooks have over 20+ tabs and 20 - 30 ranges being monitored, this approach does not work. This approach was desired for speed purposes.
Instead, the workbook will need to "check" to see if the current values are the same as the last time the save to database event was called. If not, a dirty flag will be set.
The code for this approach is provided below.
An example of the mapping range is shown in the picture below though in practice there are 20-30 rows comprising this range.
There are three other sheets where Sheet3 contains actual data in A1:H1 and Sheet2 has formulas pointing to Sheet3. Sheet1 has formulas pointing to Sheet2.
As the mapping range indicates, we are looking at a range on Sheet1, even though changes may be made to Sheet3.
The code used is as provided below.
Option Explicit
Public Sub DetermineIfEditOccurred()
Dim oMappingRange As Range
Dim szSourceTab As String
Dim szSourceRange As String
Dim oSourceRange As Range
Dim szTargetTab As String
Dim szTargetRange As String
Dim oTargetRange As Range
Dim oWorksheetSource As Worksheet
Dim oWorksheetTarget As Worksheet
Dim oRangeIntersection As Range
Dim nRowCounter As Long
Dim nCellCounter As Long
Dim szSourceValue As String
Dim szTargetValue As String
Dim oCell As Range
Dim bIsDirty As Boolean
If Range(ThisWorkbook.Names("DirtyFlag")).Value = 0 Then
Set oMappingRange = Range(ThisWorkbook.Names("Mapping"))
For nRowCounter = 1 To oMappingRange.Rows.Count
szSourceTab = oMappingRange(nRowCounter, 1)
szSourceRange = oMappingRange(nRowCounter, 2)
szTargetTab = oMappingRange(nRowCounter, 3)
szTargetRange = oMappingRange(nRowCounter, 4)
Set oWorksheetSource = ThisWorkbook.Worksheets(szSourceTab)
Set oWorksheetTarget = ThisWorkbook.Worksheets(szTargetTab)
Set oSourceRange = oWorksheetSource.Range(szSourceRange)
Set oTargetRange = oWorksheetTarget.Range(szTargetRange)
nCellCounter = 1
For Each oCell In oSourceRange.Cells
szSourceValue = oCell.Value
If szSourceValue = "#NULL!" Or _
szSourceValue = "#DIV/0!" Or _
szSourceValue = "#VALUE!" Or _
szSourceValue = "#REF!" Or _
szSourceValue = "#NAME?" Or _
szSourceValue = "#NUM!" Or _
szSourceValue = "#N/A" Then
szSourceValue = ""
End If
szTargetValue = GetCellValueByPosition(oTargetRange, nCellCounter)
If szSourceValue <> szTargetValue Then
Range(ThisWorkbook.Names("DirtyFlag")).Value = 1
bIsDirty = True
Exit For
End If
nCellCounter = nCellCounter + 1
Next
If bIsDirty Then
Exit For
End If
Next
End If
End Sub
Public Function GetCellValueByPosition(oRange As Range, nPosition As Long) As String
Dim oCell As Range
Dim nCounter As Long
Dim szValue As String
nCounter = 1
For Each oCell In oRange
If nCounter = nPosition Then
szValue = oCell.Value
Exit For
End If
nCounter = nCounter + 1
Next
GetCellValueByPosition = szValue
End Function
The Workbook_SheetChange event is as follows:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DetermineIfEditOccurred
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "MAPPING" Then
Call DetermineIfEditOccurred
End If
End Sub
I already spent hours on this problem, but I didn't succeed in finding a working solution.
Here is my problem description:
I want to loop through a certain range of cells in one workbook and copy values to another workbook. Depending on the current column in the first workbook, I copy the values into a different sheet in the second workbook.
When I execute my code, I always get the runtime error 439: object does not support this method or property.
My code looks more or less like this:
Sub trial()
Dim Group As Range
Dim Mat As Range
Dim CurCell_1 As Range
Dim CurCell_2 As Range
Application.ScreenUpdating = False
Set CurCell_1 = Range("B3") 'starting point in wb 1
For Each Group in Workbooks("My_WB_1").Worksheets("My_Sheet").Range("B4:P4")
Set CurCell_2 = Range("B4") 'starting point in wb 2
For Each Mat in Workbooks("My_WB_1").Worksheets("My_Sheet").Range("A5:A29")
Set CurCell_1 = Cells(Mat.Row, Group.Column) 'Set current cell in the loop
If Not IsEmpty(CurCell_1)
Workbooks("My_WB_2").Worksheets(CStr(Group.Value)).CurCell_2.Value = Workbooks("My_WB_1").Worksheets("My_Sheet").CurCell_1.Value 'Here it break with runtime error '438 object does not support this method or property
CurCell_2 = CurCell_2.Offset(1,0) 'Move one cell down
End If
Next
Next
Application.ScreenUpdating = True
End Sub
I've done extensive research and I know how to copy values from one workbook to another if you're using explicit names for your objects (sheets & ranges), but I don't know why it does not work like I implemented it using variables.
I also searched on stackoverlow and -obviously- Google, but I didn't find a similar problem which would answer my question.
So my question is:
Could you tell me where the error in my code is or if there is another easier way to accomplish the same using a different way?
This is my first question here, so I hope everything is fine with the format of my code, the question asked and the information provided. Otherwise let me know.
5 Things...
1) You don't need this line
Set CurCell_1 = Range("B3") 'starting point in wb 1
This line is pointless as you are setting it inside the loop
2) You are setting this in a loop every time
Set CurCell_2 = Range("B4")
Why would you be doing that? It will simply overwrite the values every time. Also which sheet is this range in??? (See Point 5)
3)CurCell_2 is a Range and as JohnB pointed it out, it is not a method.
Change
Workbooks("My_WB_2").Worksheets(CStr(Group.Value)).CurCell_2.Value = Workbooks("My_WB_1").Worksheets("My_Sheet").CurCell_1.Value
to
CurCell_2.Value = CurCell_1.Value
4) You cannot assign range by just setting an "=" sign
CurCell_2 = CurCell_2.Offset(1,0)
Change it to
Set CurCell_2 = CurCell_2.Offset(1,0)
5) Always specify full declarations when working with two or more objects so that there is less confusion. Your code can also be written as
Option Explicit
Sub trial()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Group As Range, Mat As Range
Dim CurCell_1 As Range, CurCell_2 As Range
Application.ScreenUpdating = False
'~~> Change as applicable
Set wb1 = Workbooks("My_WB_1")
Set wb2 = Workbooks("My_WB_2")
Set ws1 = wb1.Sheets("My_Sheet")
Set ws2 = wb2.Sheets("Sheet2") '<~~ Change as required
For Each Group In ws1.Range("B4:P4")
'~~> Why this?
Set CurCell_2 = ws2.Range("B4")
For Each Mat In ws1.Range("A5:A29")
Set CurCell_1 = ws1.Cells(Mat.Row, Group.Column)
If Not IsEmpty(CurCell_1) Then
CurCell_2.Value = CurCell_1.Value
Set CurCell_2 = CurCell_2.Offset(1)
End If
Next
Next
Application.ScreenUpdating = True
End Sub
Workbooks("My_WB_2").Worksheets(CStr(Group.Value)).CurCell_2.Value
This will not work, since CurCell_2 is not a method of Worksheet, but a variable. Replace by
Workbooks("My_WB_2").Worksheets(CStr(Group.Value)).Range("B4").Value