I'm trying to create a simple macro that copys the two first numbers in each cell in a column and printing them in a different column. This is in a excel-document with more than 1 worksheet. I've tried for a while to write the code, but with no prior experience, I have a hard time figuring out what to do. I know the "left()"-function is able to do this, but I don't know how I define which column to draw data from and to which column it will be printed. Any help will be greatly appreciated.
With no prior experience to writing VBA code, I am going to reccommend you stick to the formula method of doing. Honestly, even if you were familiar with VBA, you might still opt to use the formula.
A formula is put into the actual cell you want the value to be copied.
=LEFT(sourceCell, #of characters you want)
This is how it would look:
=LEFT(Sheet1!A1, 2)
Think of it as saying "this cell shall equal the first n characters in cell OO, starting from the left".
Once you are done with your formula, if you don't need it to be binded to the source anymore (if the sourceCell changes, so does the cell with the LEFT formula), you can highlight the cells, Ctrl + C to copy, then right-click and select Paste Special. Then select VALUE and hit OK and now the cells are hard-coded with the value they were showing, as if you typed it yourself.
Once you master using formulas, the next step is VBA. Don't go confusing yourself by jumping into VBA and writing code for ranges, etc. if you aren't comfortable with using =LEFT yet. One step at a time, and you'll be a pro before you know it. :)
Here is a quick sample sub to get you started:
Public Sub LeftSub()
Dim SourceRange As Range, DestinationRange As Range, i As Integer
'Define our source range as A1:A10 of Sheet1
Set SourceRange = Sheet1.Range("A1:A10")
'Define our target range where we will print.
'Note that this is expected to be of same shape as source
Set DestinationRange = Sheet1.Range("B1:B10")
'Iterate through each source cell and print left 2 bits in target cell
For i = 1 To SourceRange.Count
DestinationRange(i, 1).Value = Left(SourceRange(i, 1).Value, 2)
Next i
End Sub
How about
Sub foo()
Dim cell As Range
Dim sourceRange As Range
'//define the source column - looks for contiguous downward data from A1;
Set sourceRange = Range(Sheets("Sheet1").Range("A1"), Selection.End(xlDown))
'//iterate each cell
For Each cell In sourceRange
If IsEmpty(cell.Value) Then Exit For
'//example to place the value in corresponding row of column B in sheet 2
Sheets("Sheet2").Range("B" & cell.Row).Value = Left$(cell.Value,2)
Next
End Sub
Or an equivalent formula (in the destination cell)
=LEFT(Sheet1!A1,2)
Related
I have no experience with VBA and would love some help. As the title indicates, I'm looking for a script that fills a certain number of blank cells within column G with the average of all nonblank cells within that same range (e.g. fill all blank cells in G16:G59 with the average of all nonblank cells within G16:G59).
To make things more complicated, I'd need to vary the range somewhat dynamically as I wouldn't be sure as to how many rows I'd need to apply this script to and a work colleague who would be using this script might not have any experience with VBA either... The easiest solution I can think of is to have another cell contain the name of the last row in the range, or something like this: "Fill all blank cells in G16:Gx with the average of all nonblank cells within G16:Gx, where x = the row name listed in cell G12". Within G12 I'd have a text that states the last row to define the range, e.g. cell G12 contains the text "G80", which makes the range within the script to read G16:G80.
I know I'm asking for a lot, so if you can even just provide guidance on the first bit, I'd be very grateful! Thank you in advance for your time.
I think we can all remember what it was like when we first started out with VBA coding – which is why I’m helping you here. Normally, you’d be lucky to get any assistance with your question without providing at least some code & a description where it wasn’t doing what you wanted. Using the Record Macro button is always a good place to start.
Assumptions made here are that the data is on “Sheet1” in your file, and that there is a value in the last cell in Column G in the range you’re interested in. If that isn’t the case, let me know and I’ll show an alternative method to find the last row.
I’ve added descriptions about what (most) code does in each case to help you understand what’s going on. Let me know how you go with it.
Option Explicit '<~~ get in the habit of putting this at the top of your code
Sub FillInBlanks()
Dim ws As Worksheet '<~~ declare all variables
Dim LastRow As Long '<~~ use Long not Integer
Dim cel As Range '<~~ use intuitive variable names
Dim avg As Double '<~~ Double used here if you want decimal places in the average
Set ws = Sheets("Sheet1") '<~~ be explicit with sheet references
'Best practice to determine last used row in column
LastRow = ws.Cells(Rows.Count, "G").End(xlUp).Row '<~~ finds the last used row in column G
'Calculate the average & assign it to the variable "avg"
avg = Application.Average(ws.Range("G16:G" & LastRow))
'Loop through each cell in the defined range - one at a time
For Each cel In ws.Range("G16:G" & LastRow)
If cel = "" Then '<~~ = If the cell is blank, then...
cel = avg '<~~ ...put the average value (avg) in the cell
cel.Font.Color = RGB(51, 102, 0) '<~~ change color to suit
End If
Next cel '<~~ go to the next cell in the range
End Sub
Yesterday I learned here how to copy a row to a second sheet.
Sub maJolieProcedure(Texte As String)
With Worksheets("employes").Range("A:A")
Set c = .Find(what:=Texte)
If Not c Is Nothing Then
firstAddress = c.Row
Worksheets("employes").Rows(firstAddress).Copy _
Destination:=Worksheets("rapport").Range("A1")
MsgBox "Ok"
Else
MsgBox "Nok"
End If
End With
End Sub
To respect the formatting of the second sheet, I want to copy and paste the contents of each cell one by one.
I can identify the line number. However, I can't figure out how the Range object can return each cell one by one. For example, C3 content if Rows = 3.
Thanks a lot.
If you don't want to paste the formatting from one range to another paste values only.
Worksheets("employes").Rows(firstAddress).Copy
Worksheets("rapport").Range("A1").PasteSpecial xlValues
That's the same for all ranges, whether 1 cell or a million. The Copy process copies the subject to memory as one block. Any parsing must be done before the Copy instruction. An alternative is to read a range into an array.
Dim Arr As Variant
Arr = Worksheets("employes").Rows(firstAddress).Value
This will create a 3D array of 1 row and about 16000 columns. You might decide to limit your enthusiasm to only what you need.
With Worksheets("employees")
Arr = .Range(.Cells(firstAddress, 1), .Cells(firstAddress, .Columns.Count).End)xlToLeft)).Value
End With
Pay attention to the leading periods within the With statement. Each such period stands for the object mentioned in the With statement.
If your goal is to respect the formating of the second sheet, you don't need to loose time copying cell by cell.
It is more effective to do a paste special, like you do with the mouse:
Range("A1").Copy
Range("B1").PasteSpecial Paste:=xlPasteValues
works very well also with bigger ranges if you need:
Range("A1:A12").Copy
Range("B1:B12").PasteSpecial Paste:=xlPasteValues
or even
Range("A1:A12").Copy
Range("D3").PasteSpecial Paste:=xlPasteValues
If your goal is to really access all cell of a range individually , you just iterate on the range. For example:
For Each cell In Range("A1:A12")
cell.Value = cell.Value + 2
Next cell
I have an excel sheet with numbers in each cell. I want to eliminate the cells containing values which are larger than a specific value, different for each row, for example in the picture
I want to eliminate all the cells in a certain row that has values more than the BL cell.
Not sure the exact context in which this is being used, So possibly some conditional formatting would be more stable?
Also not sure what you meant by "Eliminate" so the following code just turns the cell red.
anyway, hopefully this code will help you get started :)
Sub Cell_Vaue_Check()
Dim row As Excel.Range
Dim cel As Excel.Range
For Each row In Sheets("Sheet1").Range("A1:C5").Rows '<<- Replace "Sheets("Sheet1").Range("A1:C5")" with the Sheet and Range you want to check
For Each cel In row.Cells
If cel.Value > Range("E" & cel.row).Value Then '<<- Replace "E" with the Column in which the check value is located
cel.Interior.Color = RGB(288, 0, 0) '<<- This line turns the cell Red. Replace it with whatever code you want depending on what "eliminate" means to you
End If
Next
Next
Set row = Nothing
Set cel = Nothing
End Sub
If Anybody has any improvements please feel free to Add!
IMPORTANT EDIT: The main issue here is caused by hidden merged cells that are causing the entirity of their active range to be selected. Unless you know a way how to dynamically skip merged cells (in a dynamic range), the it most likely won't help. Have changed the entirity of question accordingly
any idea what am I doing wrong?
Got the following code, fyi the function find_last_row returns the value of last active row as integer. In this case, the returned variable would be 40
Private Sub initalize_button_Click()
Dim lastRow As Integer
Dim ws As Worksheet: Set ws = Sheets("Training_Planner")
lastRow = find_last_row
With ws
.Activate
.Range("E5:H" & lastRow).Select
End With
End Sub
Pretty basic code, should open the worksheet Training_Planner and select from E5 to HlastRow (in this case lastRow is 40) so the selected range should be E5:H40
Here is the expected result:
What I get instead:
Curiously enough, it selects only active range, but it's as if it didn't pay attention to columns, instead of the expected E5:H40 i get B5:I40
Any idea what's causing this?
Ok, first of all, if your range is gonna start always as E5, your range is 50% dinamic, because it starts always in same column and same row. Your Range is (Cells(a,b),Cells(c,d)), this means a = 5 and b = 5 (Column E).
Also, you say and Inputbox asks users for end cell of range (in your example is H40, but this is dynamic).
So, my code checks EVERY SINGLE cell in the range formed, and then, using Application.UnionI set a final big range. We cannot just use an array to select all of them, because your range is dynamic, and selecting ranges with arrays is limited to 30 args, so we need to update our FinalRange for each cell.
Dim MyCell As Range
Dim RangeWanted As Range
Dim MyFinalRange As Range
Set RangeWanted = Range("E5:" & InputBox("Cell Address")) 'User inputs Final Cell of Range. Start is always E5
'let's get all invididual addresses of each cell inthat dynamic RangeWanted
For Each MyCell In RangeWanted
If MyCell.MergeCells = False Then 'If not merged, we add it to FinalRange
If MyFinalRange Is Nothing Then
Set MyFinalRange = MyCell
Else
Set MyFinalRange = Application.Union(MyFinalRange, MyCell)
End If
End If
Next MyCell
Set RangeWanted = Nothing
MyFinalRange.Select
With this code, from Range("E5:H40") in image,yellow cells are merged. I want to select only the not merged ones. And using this code, I get this:
My example is with Range("E5:H40") but it works also with other ranges.
Try it and adapt the code to your needs.
Whenever something small like this is happening, simply try to simplify as much as you can. In your case, it would be this:
Sub TestMe()
Worksheets("Training_Planner").Range("E5:H40").Select
End Sub
If it selects E5:H40 then everything is ok. If not, try to select it manually. Probably you have a hidden row, which is merged from B to I, thus it is happenning this way.
Instead of this:
.Range("E5:H" & lastRow).Select
Try going with this:
.Range("E5", (Cells(Rows.Count, "H").End(xlUp))).Select
It count all the rows "H" has and then goes up until it finds the first item. And it will then select from "E1" to last item in "H"
I have a spreadsheet with a large amount of data in. About half the cells are merged horizontally with other cells and contain names e.g. John Doe.
Does anyone know how to write a macro to unmerge the cells while distributing the value of the cell to all the cells that were previously merged?
Cheers
Jack
EDIT: The reason I am doing this is to check to see if two adjacent cells are equal i.e. is A1 = A2. But I run into problems when either cell is merged. If anyone knows a way around this problem without separating the cells and copying the data that would be even better!
The idea I provide below is tested for Excel 2010 VBA Win7. However, being not sure I hope it should work as for Mac, too (as this is rather set of standard properties and methods of Range object). If this doesn't work please let me know to delete my answer.
This simple code will work for selected area however it's quite easy to change it to any other range. Some other comment inside the code below.
Sub Unmerging_Selection()
Dim tmpAddress As String
Dim Cell As Range
'change Selection below for any other range to process
For Each Cell In Selection
'check if cell is merged
If Cell.MergeCells Then
'if so- check the range merged
tmpAddress = Cell.MergeArea.Address
'umnerge
Cell.UnMerge
'put the value of the cell to
Range(tmpAddress) = Cell
End If
Next
End sub
And the picture presenting before and after result:
I was able to get the solution from KazJaw to work on a mac with one edit, changing Cell.UnMerge to
ActiveSheet.UsedRange.MergeCells = False, as provided by Ron Debruin here: http://www.rondebruin.nl/mac/mac027.htm.
Sub Unmerging_Selection()
Dim tmpAddress As String
Dim Cell As Range
'change Selection below for any other range to process
For Each Cell In Selection
'check if cell is merged
If Cell.MergeCells Then
'if so- check the range merged
tmpAddress = Cell.MergeArea.Address
'umnerge
ActiveSheet.UsedRange.MergeCells = False
'put the value of the cell to
Range(tmpAddress) = Cell
End If
Next
End sub