I am trying to convert a text file to Excel sheet. I have to remove some data elements and copy some data elements to several columns. To remove some data, I have to look for a certain String (RUN). After I have that address, I have to search for the next RUN. Inside those two String range, I have to search for another String (NET) and remove it. I have to do it throughout the datasheet since this is frequent.
Here is the code I am trying to use.
Dim name As String: name = "RUN"
Dim secondName As String: secondName = "NET"
Dim rgSearch As Range
' set the range to entire sheet
Set rgSearch = Range(Cells.Address)
Dim rgSearch1 As Range
Dim cell As Range
'search for first occurrence of RUN
Set cell = rgSearch.Find(name)
Dim tempCell As Range
' If not found then exit
If cell Is Nothing Then
Debug.Print "Not found"
Exit Sub
End If
' Store first cell address
Dim firstCellAddress As String, firstRow As Integer, secondRow As Integer
'store address of first result
firstCellAddress = cell.Address
secondRow = cell.Row
Do
'save range to another range for next iteration
Set tempCell = cell.Select
'row variables are for alternate solution I tried
firstRow = secondRow
Debug.Print "Found: " & cell.Address
' search for next instance
Set cell = rgSearch.FindNext(cell)
,set next instance
secondRow = cell.Row
Set rgSearch1 = Range(tempCell, cell).Select
Loop While firstCellAddress <> cell.Address
I have also tried using
Set rgSearch1 = Range("B" & firstRow + 1 & ":B" & secondRow - 1).Select
instead of putting cells inside the range but I get the same result. That is why those firstRow, secondRow variables are there.
With both ideas, I am getting Object Required error. Could someone please show me what I am doing wrong?
Related
I have been able to find the column number and convert it to the letter, but I cannot figure out how to use the converted letter in defining a range. I keep getting a run time 1004 error.
I am trying to identify a column which contains the largest value in a specific row. Then use that column to find the first non zero cell and insert a row. Below is my code:
Sub ColNBR_Insert()
Dim maxCol As Long
Dim rngMaxCell As Range, rngVals As Range, C As Range, Where As Range
Dim lastNum0 As String
Dim ColLtr As String
Set rngVals = Worksheets("Charts").Range("F3:M3")
With Application.WorksheetFunction
Set rngMaxCell = rngVals.Find(.max(rngVals), LookIn:=xlValues)
If Not rngMaxCell Is Nothing Then
maxCol = rngMaxCell.Column
' MsgBox "The max value is in column " & maxCol
End If
End With
Set rngVals = Nothing
Set rngMaxCell = Nothing
'Convert To Column Letter
ColLtr = Split(Cells(1, maxCol).Address, "$")(1)
'Display Result
'MsgBox "Column " & maxCol & " = Column " & ColLtr
lastNum0 = "<>0"
Set C = Range(Range(ColLtr), Range(ColLtr))
C.Find(What:=lastNum0, After:=C(1), SearchDirection:=xlPrevious).Select
Selection.Offset(1).EntireRow.Insert Shift:=xlDown
End Sub
No need to do all this conversion... just use Columns.
Set C = Range(Range(ColLtr), Range(ColLtr))
although problematic, is probably easier done with
Set C = Columns(maxCol)
I am interested in renaming my document's cell references to easily perform calculations in other sheets. In the below code I am trying to name cell Di to the concatenation of the text in Ci and the year. I am using the below code and getting an error:
Sub or Function Not Defined
Any ideas?
Sub Rename()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
For i = 1 To 50
Dim rng As Range
Dim str As String
Set rng = Range("D" & i)
rng.Name = Range("C" & i) & "_" & "2019"
Next i
End Sub
My macro creates a large text file by writing all the data from all sheets in the active workbook.
In each worksheet, it is necessary to determine a certain rectangular range of cells that would be saved in the text file. It's upper left corner would always be A1, but the lower right corner should be chosen so that the range includes all cells with any content (formatting does not matter).
I thought ws.Range("A1").CurrentRegion would do the trick, but it does not work when A1 and the nearby cells are empty. If the only cell with data in the sheet is Q10, then the range should be A1:Q10.
Of course, I could loop over the ws.Cells range to discover the range of interest, but that's quite time consuming, I hope there's more effective way. If I select all cells in a sheet and do a copy-paste to notepad, I do not end up with hundreds of empty columns and thousands of empty rows, only the relevant data are copied. The question is how to replicate that with VBA.
This is my code so far:
Sub CreateTxt()
'This macro copies the contents from all sheets in one text file
'Each sheet contents are prefixed by the sheet name in square brackets
Dim pth As String
Dim fs As Object
Dim rng As Range
pth = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Dim outputFile As Object
Set outputFile = fs.CreateTextFile(pth & "\Output.txt", True)
Dim WS_Count As Integer
Dim ws As Worksheet
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Set ws = ActiveWorkbook.Worksheets(I)
outputFile.WriteLine ("[" & ws.Name & "]")
Debug.Print ws.Name
Set rng = ws.Range("A1").CurrentRegion
outputFile.WriteLine (GetTextFromRangeText(rng, vbTab, vbCrLf))
Next I
outputFile.Close
End Sub
Function GetTextFromRangeText(ByVal poRange As Range, colSeparator As String, rowSeparator As String) As String
Dim vRange As Variant
Dim sRow As String
Dim sRet As String
Dim I As Integer
Dim j As Integer
If Not poRange Is Nothing Then
vRange = poRange
Debug.Print TypeName(vRange)
For I = LBound(vRange) To UBound(vRange)
sRow = ""
For j = LBound(vRange, 2) To UBound(vRange, 2)
If j > LBound(vRange, 2) Then
sRow = sRow & colSeparator
End If
sRow = sRow & vRange(I, j)
Next j
If sRet <> "" Then
sRet = sRet & rowSeparator
End If
sRet = sRet & sRow
Next I
End If
GetTextFromRangeText = sRet
End Function
if there is anything in A1:B2 cells, this macro works. It breaks when the A1:B2 is empty and the CurrentRegion property returns Empty.
I think you should use these functions to find the last Row/Column
lastRow = Sheets("Sheetname").Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Sheets("Sheetname").Cells(1, Columns.Count).End(xlToLeft).Column
You specify the name of the sheet and the row/columb-number that you want to find the last cell with information, and it return the number of it.
(In the example the last row in first column, and last column in first row are find)
lastCol will give you an Long as an asnwer. If you want to convert this number into the column letter you can use the next function
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
I hope you find this useful
Thanks to user Rosetta, I've come up with this expression for the sought range:
ws.Range("A1:" & ws.Cells.SpecialCells(xlLastCell).Address)
I'm new to VBA and am having issues with Range syntax and what are acceptable arguments.
the purpose of this code is as follows:
user inputs value into cell D5 on Sheet2
User activates code with button
searches "configs" sheet for value
copies corresponding range after locating value
pastes range back into Sheet2
the range I am attempting to copy paste is a block that starts with the selected cell (D5) on sheet "Configs", and continues until an empty cell is found.
Sub search()
Dim GCell As Range,
Dim box As Integer
Dim Avio As String
Dim Sheet2 As Worksheet, Configs As Worksheet
Dim rw1 As String, rw2 As String
Set Configs = ActiveWorkbook.Sheets("Configs")
Set Sheet2 = ActiveWorkbook.Sheets("Sheet2")
Avio = Range("D5").Value
Set GCell = Configs.Cells.Find(Avio)
box = 0
LoopX:
box = box + 1
If GCell.Offset(box, 0).Value = "" Then
rw1 = GCell.Offset(1, -1).Address
rw2 = GCell.Offset(box, 2).Address
Configs.Range("rw1:rw2").Copy <-- this syntax doesnt seem to work...
Sheet2.Range("Avio.Offset(1,0)").Paste <-- I know this is wrong, but I would like the range to be pasted just below the selected cell on Sheet2
Else: GoTo LoopX
End If
End Sub
Is this helping?
Sub search()
Dim GCell As Range
Dim box As Integer
Dim Sheet2 As Worksheet, Configs As Worksheet
Dim rw1 As String, rw2 As String
Set Configs = ActiveWorkbook.Sheets("Configs")
Set Sheet2 = ActiveWorkbook.Sheets("Sheet2")
Dim rngAvio As Range
Set rngAvio = Sheet2.Range("D5")
Set GCell = Configs.Cells.Find(rngAvio.Value)
box = 0
Do While (GCell.Offset(box, 0).Value <> "")
box = box + 1
rw1 = GCell.Offset(1, -1).Address
rw2 = GCell.Offset(box, 2).Address
Configs.Range(rw1 & ":" & rw2).Copy rngAvio.Offset(1, 0)
Loop
End Sub
I am working through my first VBA book and would appreciate if someone would point me in the right direction. How would I transfer a range of rows into a single cell with carriage returns? I would then like to repeat this action for all ranges in the column.
I think I need to:
find the first cell with a value in the column
verify that the next row is not empty
find the last cell in the range
perform "the operation" on the range
Following up on my comments. here is a very simple way to achieve what you want.
Option Explicit
'~~> You can use any delimiter that you want
Const Delim = vbNewLine
Sub Sample()
Dim rngInput As Range, rngOutput As Range
Application.ScreenUpdating = False
Set rngInput = Range("A1:A5") '<~~ Input Range
Set rngOutput = Range("B1") '<~~ Output Range
Concatenate rngInput, rngOutput
Application.ScreenUpdating = True
End Sub
Sub Concatenate(rng1 As Range, rng2 As Range)
Dim cl As Range
Dim strOutPut As String
For Each cl In rng1
If strOutPut = "" Then
strOutPut = cl.Value
Else
strOutPut = strOutPut & Delim & cl.Value
End If
Next
rng2.Value = strOutPut
End Sub
Within the context of a worksheet-level code, the following will work. Column 2 is hard-coded, so you might want to pass in a value or otherwise modify it to fit your needs.
Dim rng As Range
Set rng = Me.Columns(2)
Dim row As Integer
row = 1
' Find first row with non-empty cell; bail out if first 100 rows empty
If IsEmpty(Me.Cells(1, 2)) Then
Do
row = row + 1
Loop Until IsEmpty(Me.Cells(row, 2)) = False Or row = 101
End If
If row = 101 Then Exit Sub
' We'll need to know the top row of the range later, so hold the value
Dim firstRow As Integer
firstRow = row
' Combine the text from each subsequent row until an empty cell is encountered
Dim result As String
Do
If result <> "" Then result = result & vbNewLine
result = result & Me.Cells(row, 2).Text
row = row + 1
Loop Until IsEmpty(Me.Cells(row, 2))
' Clear the content of the range
Set rng = Me.Range(Me.Cells(firstRow, 2), Me.Cells(row, 2))
rng.Clear
' Set the text in the first cell
Me.Cells(firstRow, 2).Value2 = result