I'm trying to convert a string of numbers into 9 digit text. The column will vary in length every time this is run.
Tried using a similar method to finding the LastRow.
Sub Macro3()
'
Dim LastRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data Validation")
Sheets("Data Validation").Select
Cells.Replace What:="-", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
LastRow = ws.Cells.find(What:="*", After:=ws.Cells(1, 1),
LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious,
MatchCase:=False).Row
Set rng = Cells(LastRow, 15)
Range("O2").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-4],""000000000"")"
Range("O2").Select
Selection.AutoFill Destination:=Range("O2:rng")
End Sub
I'd like my text format to extend down the entire column of existing numbers. Currently I'm getting a Method Range of Object _Global failed error message.
No need to Select or AutoFill.
Change the following:
Set rng = Cells(LastRow, 15)
Range("O2").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-4],""000000000"")"
Range("O2").Select
Selection.AutoFill Destination:=Range("O2:rng")
to
ws.Range("O2:O" & LastRow).FormulaR1C1 = "=TEXT(RC[-4],""000000000"")"
It's my own preference to avoid FormulaR1C1:
ws.Range("O2:O" & LastRow).Formula = "=TEXT(K2,""000000000"")"
Related
I'm new to VBA code. Attempting to Fill values for filtered range in a particular column ("M") and below code is attempted
Dim prg_type As String
Dim header_name As String
Dim MyColumnNumber As Integer
Dim aCell As Range
Dim i As Integer
Dim c As Excel.Range
For i = 1 To 7
header_name = ActiveWorkbook.Worksheets("Execution").Cells(i + 3, 2).Text
prg_type = ActiveWorkbook.Worksheets("Execution").Cells(i + 3, 3).Text
Sheets("Raw Data").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Set aCell = ActiveWorkbook.Worksheets("Raw Data").Rows(1).Find(What:="program_type", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
MyColumnNumber = aCell.Column
ActiveSheet. Range("$A$1:$M$300000").AutoFilter Field:=MyColumnNumber, Criteria1:="="
Set aCell = ActiveWorkbook.Worksheets("Raw Data").Rows(1).Find(What:=header_name, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
MyColumnNumber = aCell.Column
ActiveSheet.Range("$A$1:$M$300000").AutoFilter Field:=MyColumnNumber, Criteria1:="1"
For Each c In Range("M2:M" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
If c.Offset(, -1).Value = vbNullString Then Exit For
c.Value = prg_type
Next
ActiveWorkbook.Worksheets("Raw Data").AutoFilterMode = False
ActiveWorkbook.Worksheets("Raw Data").Range("A1").Select
Next i
Since I'm using for loop, It's executing for ever for just 25K rows of data. Can I know better way to handle?
I need a loop to copy cells offset from a found value in SOURCE, (based on range in DESTINATION) to DESTINATION.
In this case I want to copy value from SOURCE ("K10") to DESTINATION ("G5"), after value ("E10") found in SOURCE based on value ("H5") in DESTINATION.
I need to search for all values in DESTINATION ("H:H").
Book_source.xlsx
Book_destination.xlsx
My recorded code:
Windows("Book_destination.xlsx").Activate
Dim rng As Variant
rng = Range("H5").Value
rng.Select
Selection.Copy
Application.WindowState = xlNormal
Windows("Book_source.xlsx").Activate
Cells.Find(What:=rng, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 6).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book_destination.xlsx").Activate
Range("G5").Select
ActiveSheet.Paste
I created this code and is working for me.
For anyone interested
Thanks all of you. :)
Enjoy, it's free!
I'm glad to share this.
Sub part_of_code()
Dim i As Integer
i = 2
'calling LastRow
Call LastRecord(LastRow)
For i = i To LastRow
On Error Resume Next
'Application.WindowState = xlNormal
Range("H" & i).Select
Selection.Copy
Dim rng As Variant
rng = Range("H" & i)
Workbooks("Book2.xlsx").Worksheets("Sheet1").Activate
Cells.Find(What:=rng, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 6).Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("Book1.xls").Worksheets("Sheet2").Activate
Range("H" & i).Offset(0, -1).Select
ActiveSheet.Paste
Next i
End Sub
Private Sub LastRecord(LastRow)
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
End Sub
I would like to add the code "If Not FindRng Is Nothing Then", How can I do it? Here below there is the code that is working only when finds something!
Sub ORDER()
Dim wordToSearch As String
Dim rowToDelete As Integer
Sheets("Dashboard").Select
RowCount = Cells(Cells.Rows.Count, "W").End(xlUp).Row
For i = 1 To RowCount
Range("W" & i).Select
check_value = ActiveCell
If check_value = "Y" Or check_value = "y" Then
Sheets("Dashboard").Select
wordToSearch = Sheets("Dashboard").Range("L" & i).Value
Sheets("Order").Select
Cells.Find(What:=wordToSearch, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
rowToDelete = ActiveCell.Row
Rows(rowToDelete & ":" & rowToDelete).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("Dashboard").Select
End If
Next
End Sub
The better (and safer) way to use Find is to Set a Range to the result of the Find, and in case Find failed to "find" a match, then the result will be Range = Nothing, and you can try to trap this type of error by using If Not FindRng Is Nothing Then.
Code
Sub Macro()
Dim FindRng As Range
With Sheets("order")
Set FindRng = .Cells.Find(What:=Sheets("Dashboard").Cells(2, 4), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not FindRng Is Nothing Then ' find was successful
FindRng.EntireRow.Delete
Else ' Find failed to find a match
MsgBox "Unable to find " & Sheets("Dashboard").Cells(2, 4), vbCritical
End If
End With
End Sub
i want to pop up a inputbox when LR is coming..
Look in code:
LR = Range("G" & Rows.Count).End(xlUp).Row
Range("G2:G" & LR).Select
Sub FixIt()
Dim LR As Long
LR = Range("G" & Rows.Count).End(xlUp).Row
Range("G2:G" & LR).Select
Selection.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.NumberFormat = "0.00"
Selection.Style = "Comma"
End Sub
You can use the Application.InputBox with Type:=8 to specify an input box which will have as its return value a Range object.
Here is an example of using such an input box to get the row number of a selected cell.
Dim inRange as Range
Set inRange = Application.InputBox("Please select a cell...", Type:=8)
If Not inRange Is Nothing Then
LR = inRange.Row
Else
'Probably you want to Exit Sub here or do some error-handling
End If
Or, to use the same approach to get the entire range of selection:
Dim myRange as Range
Set myRange = Application.InputBox("Please select some range...", Type:=8)
If myRange Is Nothing Then
'Probably you want to Exit Sub here or do some error-handling
End If
'proceed with the rest of your code...
With myRange
.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.NumberFormat = "0.00" Selection.Style = "Comma"
End With
So I have two excel documents.
One to take data from (RESULT.xlsm).
Another to insert data into (Summary.xls).
What I want is the adjacent cell values next to the hightlighted names to get inserted into Summary.xls under the respective columns. So I tried recording a macro but what happens is only the first record gets inserted.
Since only two links are allowed for me, i put it all in one picture:
http://i50.tinypic.com/9veihl.png
Note: There are multiple records in RESULT.xlsm and the screenshot shows just one.
I would like help on how I can extract data from all the set of records and insert in Summary.xlsx
Here's the recorded macro code:
Sub Summ()
Workbooks.Open Filename:="Summary.xlsx"
Windows.Arrange ArrangeStyle:=xlVertical
Windows("RESULT.xlsm").Activate
Cells.Find(What:="Air System Name", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B10").Select
Selection.Copy
Windows("Summary.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("RESULT.xlsm").Activate
Cells.Find(What:="Floor Area", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Summary.xlsx").Activate
Range("B5").Select
ActiveSheet.Paste
Windows("RESULT.xlsm").Activate
Cells.Find(What:="Total coil load", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Summary.xlsx").Activate
Range("C5").Select
ActiveSheet.Paste
Windows("RESULT.xlsm").Activate
Cells.Find(What:="Sensible coil load", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("B28").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Summary.xlsx").Activate
Range("D5").Select
ActiveSheet.Paste
Windows("RESULT.xlsm").Activate
Cells.Find(What:="Max block L/s", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("B30").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Summary.xlsx").Activate
Range("E5").Select
ActiveSheet.Paste
Range("A6").Select
End Sub
I've also attached the excel files at mediafire:
Excel files
Please do help.
Thanks alot:)
So I looked up at alot of resources and tried to follow what #Tim Williams told me to and stumbled across this page (the last part): https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/text-functions/column-sets-to-rows
They had a solution almost close to my problem, so I made a few modifications and I'm done:D
Note: This is within the same document, different sheets.
The code of it:
Dim LR As Long, NR As Long, Rw As Long
Dim wsData As Worksheet, wsOUT As Worksheet
Dim HdrCol As Range, Hdr As String, strRESET As String
Set wsData = Sheets("Sheet1") 'source data
Set wsOUT = Sheets("Sheet2") 'output sheet
strRESET = " Air System Name " 'this value will cause the record row to increment
LR = wsData.Range("A" & Rows.Count).End(xlUp).Row
'end of incoming data
Set HdrCol = wsOUT.Range("1:1").Find(strRESET, _
LookIn:=xlValues, LookAt:=xlWhole) 'find the reset category column
If HdrCol Is Nothing Then
MsgBox "The key string '" & strRESET & _
"' could not be found on the output sheet."
Exit Sub
End If
NR = wsOUT.Cells(Rows.Count, HdrCol.Column) _
.End(xlUp).Row 'current output end of data
Set HdrCol = Nothing
On Error Resume Next
For Rw = 1 To LR
Hdr = wsData.Range("A" & Rw).Value
If (Hdr = " Air System Name ") Then
NR = NR + 1
End If
If Hdr <> "" Then
Set HdrCol = wsOUT.Range("1:1").Find(Hdr, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not HdrCol Is Nothing Then
wsOUT.Cells(NR, HdrCol.Column).Value _
= wsData.Range("B" & Rw).Value
Set HdrCol = Nothing
End If
End If
Next Rw
The only little problem is the space. In my excel document, my report has trailing and leading spaces, and this doesn't match with my sheet2 columns headers, I kind of temporarily fixed it, since I looked around and couldn't find a way to automatically trim all the space from the whole column.
So that's it:)