I am relative new to vba.
I am trying to get this code to work.
Sub EksportAsCSV_DK()
Const Delim As String = ";" 'afgrænser (delimiter)
Dim strFileName As String
Dim rngOmr As Range
Dim y As Long 'tæller
Dim x As Long 'tæller
Dim strTemp As String 'streng til de enkelte rækker
Dim lRows As Long 'antal rækker
Dim lCols As Long 'antal kolonner
Dim lFno As Long 'fil nummer
Sheets("in").Select
Range("A1:Q24").Select
strFileName = Application.GetSaveAsFilename(fileFilter:="CSV-Fil(*.csv), *.csv")
Set rngOmr = Selection.CurrentRegion
lFno = FreeFile
lRows = rngOmr.Rows.Count
lCols = rngOmr.Columns.Count
Open strFileName For Output As #lFno
For x = 1 To lRows
strTemp = ""
For y = 1 To lCols
strTemp = strTemp & rngOmr(x, y).Text
If y < lCols Then
strTemp = strTemp & Delim
Else
Print #lFno, strTemp
End If
Next
Next
Close #lFno
Sheets("User page").Select
End Sub
The major problem is, that from A1 to Q17 is locked for the machines software. Row 2 is blank, and maybe because of that it ignores anything from row 2 and up to row 24, which is the maximum I need.
I also want the sheet named "in" in saved CSV file.
You are correct that the count you are using for lRows is returning 1 rather than 24 because of the blank row. Given that you are fixing the range by stating A!:Q24 lRows doesn't need to be dynamic it should always be 24, so you could change it to lRows = 24. Alternatively if the range in your code is going to be changed to a dynamic range later you could use a different method to find the last row number. If I have gaps in my data (assuming I'm in ColumnA) I usually use:
Range("A1048576").select
Selection.End(xlUp).Select
lRows = ActiveCell.Row
An alternative would be to use specialcells(last cell) I'd generally record something like that and then edit it.
For saving as a csv file:
ActiveWorkbook.SaveAs Filename:="C:\Users\stuar\Documents\in.csv", _
FileFormat:=xlCSV, CreateBackup:=False`
`
Related
New working on VBA with excel. Learning on my own and happy this community exist.
I am working on picking information from a string within a cell in excel.
Example:
cell value: Make.Model.Issuer
I'm trying to read any set of characters using the "." as limits.
read from right till "."
read between "."
read from left till "."
Thank you all in advance :)
The following code will generate an array with the picked words:
Dim s As String
Dim a As Variant
s = "Make.Model.Issuer"
a = Split(s, ".")
MsgBox a(0) & " " & a(1) & " " & a(2)
I'm not sure what you're doing with the extracted strings so I'm going to place them in cells.
This will iterate down column A and place the split string into as many columns as it needs to in the same row.
Dim strarr As Variant
Dim i As Long
Dim lr As Long
Dim j As Long
With Sheet1 'Change as needed
lr = .Cells(.Rows.Count, 1).End(xlUp).Row 'Change the 1 to whatever your column is
For i = 1 To lr
strarr = Split(.Cells(i, 1).Value, ".") 'Change the 1 to whatever your column is
For j = LBound(strarr) To UBound(strarr)
.Cells(i, 1).Offset(, j + 1).Value = strarr(j)
Next j
Next i
End With
I am trying to copy data from one workbook to another.
my source workbook, contains data with 722 rows. but the code is copying only 72 rows.
While I was debugging, in siiurcewkbk, I could see 722 rows being selected but then in destwkb its just 72 rows being pasted.
also, the column in my sourcewb is in AK and I want them to be pasted in column A of destwb.
Could anyone help me to rectify this issue.
Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long
CopyCol = Split("AK", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LCell = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Address
LCC = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Column
lcr = Activewindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Row
Set y = ThisWorkbook
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\Downloads"
Set x = Workbooks.Open(filename:=Path2 & "\Red.xlsx")
For Count = 0 To UBound(CopyCol)
Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & lcr)
If Count = 0 Then
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("All").Paste y.Sheets("All").Range("A4")
Application.CutCopyMode = False
x.Close
End Sub
anylead would be helpful.
If you are just coping one column of data from one worksheet to another column in another worksheet there is a lot easier way of doing it.
Does the code below help? Sorry if I've misunderstood your requirements ...
Sub Extract()
Dim Path2 As String '** path to the workbook you want to copy to ***
Dim X As Workbook '*** WorkBook to copy from ****
Dim Y As Workbook '** WorkBook to copy to
Set X = ActiveWorkbook '** This workbook ****
Path2 = "C:\test" '** path of book to copy to
Set Y = Workbooks.Open(filename:=Path2 & "\Red.xlsx")
X.Sheets("From").Range("A:A").Copy Destination:=Y.Sheets("ALL").Range("A1")
Application.CutCopyMode = False
Y.Save
Y.Close
End Sub
Try this, I commented out some lines that were doing nothing as far as I can see because I'm strict about code. Also I added some Dim statements because I always write code with Option Explicit at the top of module, this is there to help the programmer as it traps hidden compile errors.
The solution to your problem is in the lines
Dim rngLastCell As Excel.Range
Set rngLastCell = Range(CopyCol(Count) & "65535").End(xlUp)
so what we're doing here is go to the last line of the sheet on row 65535 (I know later versions have more rows but this number is fine) and then we say End(xlUp) which logically means go up this column until you find some text which will be the bottom row of your block of data.
Just underneath I changed the syntax of the Range statement which is very flexible so one call Range with a string like Range("A1:B3") or one can call Range with two arguments each of them cells, so Range(Range("A1"),Range("B3")).
Option Explicit
Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long
Dim CopyCol
CopyCol = Split("AK", ",")
'* LR is never used
'LR = Cells(Rows.Count, 1).End(xlUp).Row
'* lc is never used
'lc = Cells(1, Columns.Count).End(xlToLeft).Column
'* LCell is never used
'LCell = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Address
'* LCC is never used
'LCC = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Column
Dim lcr
lcr = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Row
Set y = ThisWorkbook
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\Downloads"
Set x = Workbooks.Open(filename:=Path2 & "\Red.xlsx")
Dim Count As Long
For Count = 0 To UBound(CopyCol)
Dim rngLastCell As Excel.Range
Set rngLastCell = Range(CopyCol(Count) & "65535").End(xlUp)
Dim temp As Excel.Range
'Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & lcr)
Set temp = Range(CopyCol(Count) & "1", rngLastCell)
If Count = 0 Then
Dim CopyRange As Excel.Range
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("All").Paste y.Sheets("All").Range("A4")
Application.CutCopyMode = False
x.Close
End Sub
CopyCol = Split("AK", ",") is Array("AK")... why?
For Count = 0 To UBound(CopyCol) ... Next runs from 0 to 0 (one cycle).
to put it in an shorter sub, I recommend something like this:
Sub Extract()
Dim path1 As String
path1 = ThisWorkbook.Path & "\Downloads"
Dim CopyCol As String
CopyCol = "AK"
With Workbooks.Open(filename:=path1 & "\Red.xlsx")
With .ActiveSheet
.Range(.Cells(1, CopyCol), .Cells(.Rows.Count, CopyCol).End(xlUp)).Copy ThisWorkbook.Sheets("All").Range("A4")
End With
.Close
End With
End Sub
I'm trying to write an Excel macro that will look at the dates in column A and print each month listed in a column F. I am trying to use a for loop and If/Else statements but I can't seem to get it to work out correctly.
y = 2
Range("F2").Formula = "=MONTH(A3)"
For x = 4 To RowLast - 1
If Range("A" & x).Month = Range("F" & y) Then
Else
y = y + 1
Range("F" & y).Formula = "=MONTH(A" & x & ")"
End If
Next
That is what I have thus far and it should print the first month found in Cell A3 to Cell F2 (which works), then go through every other date until it hits one line above the last. The if statements should check to make sure it's a new month and if it is print the month to the next cell in column F.
Please let me know if you have any questions. Thank you.
I think your if statement is causing the problems. Do you even need an if statement here if you are just printing the month?
RowLast = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
y = 2
Range("F2").Formula = "=MONTH(A3)"
For x = 4 To RowLast - 1
Range("Z2").Formula = "=MONTH(A" & x & ")"
If Range("Z2").Value = Range("F" & y).Value Then
Else
y = y + 1
Range("F" & y).Formula = "=MONTH(A" & x & ")"
End If
Next
To answer your specific question: Month(date) is a function that returns an integer corresponding to the month of the date argument. So Month(Now) would return 3, for example.
.Month is not a property of the .Range object so your code would throw an error ("Object doesn't support this property or method"). The code below shows how to use the Month() function in the way you want.
However, your code poses a wider question. Are you using VBA merely to automate your formula writing? If you are, then all well and good. But is it possible that you are using worksheet functions when, actually, VBA would serve you better? Is there a reason, for example, that you would use VBA to identify target months only to write those target months to your worksheet by way of an Excel formula?
I mention it because quite a few posts recently have limited their scope to how to automate Excel functions (probably as a result of recording macros) whereas VBA can be more capable than their imagination might allow.
Anyhow, here are two very similar versions of the same task: the first that writes the formulae and the second that writes the months. I hope it'll provoke some thought as to which automation type suits your needs:
Code to write the formulae:
Public Sub FormulaGenerator()
Dim ws As Worksheet
Dim firstRow As Long
Dim lastRow As Long
Dim dateRange As Range
Dim cell As Range
Dim hitList As Collection
Dim refMonth As Integer
Dim thisMonth As Integer
Dim r As Long
Dim output() As Variant
Dim item As Variant
'Set these for your own task.
Set ws = ThisWorkbook.Worksheets("Sheet1")
firstRow = 3
lastRow = 20
'Read the values cell by cell
Set dateRange = ws.Range(ws.Cells(firstRow, "A"), ws.Cells(lastRow, "A"))
Set hitList = New Collection
For Each cell In dateRange.Cells
item = cell.Month
thisMonth = Month(cell.Value)
If thisMonth <> refMonth Then
'It's a new month so populate the collection with the cell address
hitList.Add cell.Address(False, False)
refMonth = thisMonth
End If
Next
'Populate the output array values
ReDim output(1 To hitList.Count, 1 To 1)
r = 1
For Each item In hitList
output(r, 1) = "=MONTH(" & item & ")"
r = r + 1
Next
'Write the output array starting at cell "F2"
ws.Cells(2, "F").Resize(UBound(output, 1)).Formula = output
End Sub
Code to write the months as integers:
Public Sub OutputGenerator()
Dim ws As Worksheet
Dim firstRow As Long
Dim lastRow As Long
Dim dates As Variant
Dim hitList As Collection
Dim refMonth As Integer
Dim thisMonth As Integer
Dim r As Long
Dim output() As Integer
Dim item As Variant
'Set these for your own task.
Set ws = ThisWorkbook.Worksheets("Sheet1")
firstRow = 3
lastRow = 23
'Read the dates into an array
dates = ws.Range(ws.Cells(firstRow, "A"), ws.Cells(lastRow, "A")).Value
'Loop through the array to acquire each new date
Set hitList = New Collection
For r = 1 To UBound(dates, 1)
thisMonth = Month(dates(r, 1))
If thisMonth <> refMonth Then
'It's a new date so populate the collection with the month integer
hitList.Add thisMonth
refMonth = thisMonth
End If
Next
'Populate the output array
ReDim output(1 To hitList.Count, 1 To 1)
r = 1
For Each item In hitList
output(r, 1) = item
r = r + 1
Next
'Write the output array starting at cell "F2"
ws.Cells(2, "F").Resize(UBound(output, 1)).Value = output
End Sub
I have a Range of data in text file like 102201906000-102201911999-23451 around thousands. i want to create a new text file to create the range into numbers like.
102201906000 23451
102201906001 23451
102201906002 23451
till
102201911999 23451
Keeping the last digit as fixed.
I have made following code.
Private Sub CommandButton21_Click()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim lCol As Long
Dim rngEnd As String
Dim rng1 As String
Dim rng2 As String
Dim x As Long
Dim Num As Range
For Each Num In Range("A1:A" & LastRow)
lCol = ActiveSheet.UsedRange.Columns.Count
rngEnd = Split(Num, "-")(2)
rng1 = Split(Num, "-")(0) - 1
rng2 = Split(Num, "-")(1)
For x = 1 To rng2 - rng1
Cells(x, lCol + 1) = rng1 + x & " " & rngEnd
Next x
Next Num
Application.ScreenUpdating = True
End Sub
But as i have huge data i am unable to use it properly.
Can i get some help on to create a text file itself when i run a macro without using the spreadsheet.
Waiting for expert advises.
Assuming that you have a text file and want to create another textfile where each line like 102201906000-102201911999-23451 is replaced by a number of lines like 102201906000 23451 it is more natural to use VBScript than straight VBA. You can bypass the need to pull the data into Excel (but -- it is written as an Excel macro so you need to call it from Excel. With minor modification you can remove Excel from the loop completely and use pure VBScript).
To use it you have to include a reference to Microsoft Scripting Runtime to your projects (Tools/References in the VBA editor).
Sub ExpandData(inName As String, outName As String)
Dim FSO As New FileSystemObject
Dim tsIn As TextStream
Dim tsOut As TextStream
Dim startNum, endNum, i, line 'variants
On Error GoTo err_handler
Set tsIn = FSO.OpenTextFile(inName, ForReading)
Set tsOut = FSO.OpenTextFile(outName, ForWriting, True)
Do While tsIn.AtEndOfStream = False
line = Split(tsIn.ReadLine, "-")
If UBound(line) = 2 Then
startNum = CDec(line(0))
endNum = CDec(line(1))
For i = startNum To endNum
tsOut.WriteLine i & " " & line(2)
Next i
End If
Loop
tsIn.Close
tsOut.Close
Exit Sub
err_handler:
Debug.Print "I'm confused!"
End Sub
Used like thus (inName must be different from outName):
Sub test()
ExpandData "C:\Programs\test.txt", "C:\Programs\testout.txt"
End Sub
I would attempt to write then all at once. Looping through and examining them individually should not be necessary if they are sequential.
Private Sub CommandButton21_Click()
Application.ScreenUpdating = False
Dim lr As Long, nmbr As Long, bgn As String, nd As String
With Worksheets("Sheet1") '<~~set this worksheet properly!
lr = .Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
nd = .Cells(1, 1).Value2
bgn = left(nd, 7)
nmbr = CLng(Mid(nd, 8, 5))
nd = right(nd, 5)
With .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(lr, 1)
.Formula = "=""" & bgn & """&TEXT(ROW(" & Rows(nmbr).Address(0, 0) & "), ""00000_)"")&""" & nd & """"
.Value = .Value2
End With
End With
Application.ScreenUpdating = True
End Sub
This generate sequential number based upon the ROW function. The prefix and suffix are peeled off the first value in A1 only once and used afterwards as string vars.
I have a large Excel file and I need to replace all values in 12 columns completely.
Right now, there is a formula in each one of the cells, and I need to replace that formula with my own.
How do I loop through all those columns, knowing at what row it starts but don't know the end row (file is updated constantly). The hack of "A600000" seems overkill.
I am new to VBA and some guidance would be really appreciated.
ActiveSheet.UsedRange is the range of all the used cells on the current sheet.
You can use ActiveSheet.UsedRange.Rows.Count and .Columns.Count to get the height and widht of this range.
Here's a very crude function that hits every cell in the range:
Sub test()
Dim thisRange As Range
Set thisRange = ActiveSheet.UsedRange
With thisRange
For y = 1 To .Rows.Count
For x = 1 To .Columns.Count
thisRange.Cells(y, x).Value = "Formula here"
Next x
Next
End With
End Sub
But what you want may be different, can you be more specific?
The below will accomplish what you need to do. You just need to supply the startRow, .Sheets("Name"), and i arguments. If the columns are all the same length, then UsedRange will work fine if there are not random cells with values outside and below the columns you are interested in. Otherwise, try this in your code (on a throw away copy of your workbook)
Sub GetLastRowInColumn()
Dim ws as Excel.Worksheet
Set ws = Activeworkbook.Sheets("YOURSHEETNAMEHERE")
Dim startRow as long
startRow = 1
Dim lastRow as long
Dim i as long
For i = 1 to 12 'Column 1 to Column 12 (Adjust Accordingly)
lRow = ws.Cells(ws.Rows.Count, i).End(xlUp).Row
ws.Range(ws.Cells(startRow, i), ws.Cells(lRow, i)).Formula = "=Max(1)" 'Sample Formula
Next
End Sub
EDIT : Fixed typo
The below function will build the range with varying length columns. Use the function to return the desired range and fill all related cells in one shot.
Function GetVariantColumnRange(MySheet As Excel.Worksheet, _
TopRow As Long, StartColumn As Long, LastColumn As Long) As Excel.Range
Dim topAddress As String
Dim bottomAddress As String
Dim addressString As String
Dim i As Long
For i = StartColumn To LastColumn
topAddress = MySheet.Cells(TopRow, i).Address
bottomAddress = MySheet.Cells(MySheet.Rows.Count, i).End(xlUp).Address
addressString = addressString & ", " & topAddress & ":" & bottomAddress
Next
addressString = Right(addressString, Len(addressString) - _
InStr(1, addressString, ", ", vbBinaryCompare))
Set GetVariantColumnRange = MySheet.Range(addressString)
End Function
Usage follows...
Sub Test()
Dim myrange As Range
Set myrange = GetVariantColumnRange(ThisWorkbook.Sheets(1), 1, 1, 12)
myrange.Select 'Just a visual aid. Remove from final code.
myrange.Formula = "=APF($Jxx, "string1", "string2") "
End Sub