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`
`
So, I've been scratching my head for a couple of hours now trying to figure this out. No matter where I look and what I do, I can't seem to make it work.
I have an excel document with ~20 columns and a completely variable number of rows. I want to concatenate each adjacent cell within the defined width (columns A:V)into the first cell (A1 for the first row), and then move to the next row and do the same until I get to the bottom. Snippet below:
Example before and after I'm trying to make
I have the code that does the concatenation. To make it work I have to select the cells I want to concatenate (A1:V1), and then execute the code. Even though some cells are blank, I need the code to treat them this way and leave semicolons there. The code works exactly as I need it to, so I've been trying to wrap it in some sort of Range select, offset, loop:
Dim c As Range
Dim txt As String
For Each c In Selection
txt = txt & c.Value & ";"
Next c
Selection.ClearContents
txt = Left(txt, Len(txt) - 2)
Selection(1).Value = txt
What I am struggling with is making the selection A1:V1, running the code, and then looping this down to A2:V1, A3:V3, etc. I think this can be done with a loops and an offset, but I cannot for the life of me work out how.
Any help at all would be much appreciated :)
This uses variant Arrays and will be very quick
Dim rng As Range
With Worksheets("Sheet4") 'change to your sheet
'set the range to the extents of the data
Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 22).End(xlUp))
'Load data into an array
Dim rngArr As Variant
rngArr = rng.Value
'create Out Bound array
Dim OArr() As Variant
ReDim OArr(1 To UBound(rngArr, 1), 1 To 1)
'Loop array
Dim i As Long
For i = LBound(rngArr, 1) To UBound(rngArr, 1)
'Combine Each Line in the array and load result into out bound array
OArr(i, 1) = Join(Application.Index(rngArr, i, 0), ";")
Next i
'clear and load results
rng.Clear
rng.Cells(1, 1).Resize(UBound(OArr, 1)).Value = OArr
End With
Here's a quick little script I made up to do this - the main thing to note is that I don't use selection, I used a defined range instead.
Sub test()
Dim i As Long
Dim target As Range
Dim c As Range
Dim txt As String
For i = 3 To 8
Set target = Range("A" & i & ":C" & i)
For Each c In target
txt = txt & c.Value & ";"
Next c
Cells(i + 8, "A").Value2 = Left$(txt, Len(txt) - 1)
txt = ""
Next i
End Sub
Just change the range on the below to your requirements:
Sub concat_build()
Dim buildline As String
Dim rw As Range, c As Range
With ActiveSheet
For Each rw In .Range("A2:V" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1).Rows
buildline = ""
For Each c In rw.Cells
If buildline <> "" Then buildline = buildline & ";"
buildline = buildline & c.Value2
Next
rw.EntireRow.ClearContents
rw.EntireRow.Cells(1, 1) = buildline
Next
End With
End Sub
I want to remove single word from multiple words separated by comma:
I Want a macro that should work for all sheets in workbook.
I have the following data in Column A in Sheet1, Sheet2, Sheet3.
The no of rows and data differ for different sheets.
Little Nicobar
Mildera
Mus
Nancowrie
Nehrugram
Pilomilo Island
and Following data in Column Q:
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Want output in Column R as follows:
Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram
Means i want remove word in column A from Column R.
For this we can use the formula in R1
=TRIM(SUBSTITUTE(Q1,A1,""))
But its only working for R1.
I want a macro that provides the desired output and should work for all sheets. As the different data present in Sheet1, sheet2...sheetn.
Help me.
Try this
Sub test()
Dim vDB, vData, vR()
Dim s As String
Dim Ws As Worksheet
Dim i As Long, n As Long
For Each Ws In Worksheets
With Ws
vDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp))
n = UBound(vDB, 1)
vData = .Range("q1").Resize(n)
ReDim vR(1 To n, 1 To 1)
For i = 1 To n
s = Replace(vData(i, 1), vDB(i, 1), "")
s = Replace(s, ",,", ",")
If Left(s, 1) = "," Then
Mid(s, 1, 1) = Space(1)
End If
If Right(s, 1) = "," Then
Mid(s, Len(s), 1) = Space(1)
End If
vR(i, 1) = Trim(s)
Next i
.Range("r1").Resize(n) = vR
End With
Next Ws
End Sub
Write this formula in R1 and drag down
=SUBSTITUTE(Q1,","&A1,"")
I feel like this is definitely possible with excel functions as VB seems like overkill. This puts your large string in col Q into an array and removes whatever the value in col A is. See my answer below and let me know if you have any issues. This is also assuming your data doesn't have headers.
Sub ReplaceThings()
Dim wbk As Workbook
Dim wksht As Worksheet
Dim RemoveMe As String, myList() As String, myText As String
Dim Cell As Range
Dim x As Long, lRow As Long, p As Long
Set wbk = Workbooks("StackOverflow.xlsm") 'Change this to your workbook name
'Loop through each worksheet in workbook
For Each wksht In wbk.Worksheets
With wksht
'Find last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For Each Cell In .Range("A1:A" & lRow)
RemoveMe = Cell.Value
'Fill array with data in Column Q
myList = Split(Cell.Offset(0, 16).Value, ",")
For x = LBound(myList) To UBound(myList)
'Loop through array and check if RemoveMe is in Array
If myList(x) = RemoveMe Then
'Remove value from array
For p = x To UBound(myList) - 1
myList(p) = myList(p + 1)
Next p
Exit For
End If
Next x
'Print value to column Q
For x = LBound(myList) To UBound(myList)
If x = 0 Then
myText = myText & myList(x)
Else
myText = myText & "," & myList(x)
End If
Next x
Cell.Offset(0, 17) = myText
myText = ""
Erase myList
Next Cell
End With
Next wksht
End Sub
I'm having a big trouble with my situation right now. My question is, is there any way I can delete the cell contents if its cell value has a string Total Attachment Size: ?
I have this part but don't know how to proceed. Been searching in the net for any ideas, but unfortunately it is not enough.
dim lastrow as integer
dim ws as worksheet
set ws = ThisWorkbook.sheets("Sheet1")
lastrow = ws.cells(rows.count, 8).end(xlup).row
if ws.range("H" & lastrow) contains `Total Attachment Size: ` then
ws.range("H" & lastrow).clearcontents
lastrow = ws.cells(rows.count, 8).end(xlup).row
end if
Any help is much appreciated.
This is as per your code, if you want to check all H column values then let me know, we can run a loop and clear all cells containing the value
Dim str As String
On Error Resume Next
str = Application.WorksheetFunction.Search("Total Attachment Size: ",Sheet1.Range("H" & Sheet1.Range("H500000").End(xlUp).Row).Value, 1)
If Err.Number = 0 Then
Sheet1.Range("H" & Sheet1.Range("H500000").End(xlUp).Row).ClearContents
End If
I have a TextBox and ListBox. I want to find a string in a range containing specific multiple words (keywords) written in TextBox and display it in the ListBox
For example:
I have a string a = "Sun is shinning"
And I want to research the range, find and display cell value containing these specific words when I write in TextBox for example "sun shinning".
Take a look into my last string where I write word "sun" in lowercase.
I wrote the code
Sub AAA()
Dim ws As Worksheet
Set ws = Worksheets("BBB")
Dim LastRow As Long
Dim i As Long
ZZZ.Clear
LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row
With ZZZ
.ColumnCount = 3
.ColumnWidths = "100;400"
For i = 2 To LastRow
' For x = 0 To UBound(z)
If ws.Range("E" & i) Like AAA
.Value & "*" Then
.AddItem ws.Range("D" & i)
.column(1, ZZZ.ListCount - 1) = ws.Range("E" & i)
'.column(2, ZZZ.ListCount - 1) = ws.Range("E" & I)
End If
' Next x
Next i
End With
End Sub
But each time when I try to add second loop responsible for splitting the sentence and loop by each word I get an error message.
Have you got any idea how to simply modify my code to do that?
Assuming multiple words entered into textbox AAA are always entered with spaces, this procedure works (tried and tested).
The procedure uses the Split function to load the word(s) in the AAA textbox into an array, then loops the array for each cell.
Sub AAA()
Dim ws As Worksheet
Set ws = Worksheets("BBB")
Dim LastRow As Long
Dim i As Long
ZZZ.Clear
LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row
With ZZZ
.ColumnCount = 3
.ColumnWidths = "100;400"
For i = 2 To LastRow
Dim sWords() As String, x As Integer
sWords = Split(AAA.Value, " ")
For x = 0 To UBound(sWords)
If ws.Range("E" & i) Like "*" & sWords(x) & "*" Then
.AddItem ws.Range("D" & i)
.Column(1, Sheet1.ZZZ.ListCount - 1) = ws.Range("E" & i)
End If
Next x
Next i
End With
End Sub
As I type this I had the thought that it may be even faster to loop the array once and Find any matches of each word in the entire range, but I will leave that up to you.