ANY IDEA ??? I don't know why there's a type error especially that i've changed the type of both cells
Cells(i, 7).NumberFormat = "#"
Workbooks("template.xls").Worksheets("Introduction").Cells(j, 21).NumberFormat = "#"
If Left(Cells(i, 7), 13) = Workbooks("template.xls").Worksheets("Introduction").Cells(j, 21).Value
.
.
.
Code from comments:
Dim i As Long
Dim j As Integer
For j = 5 To derlig
For i = 2 To 4000
Cells(i, 2).NumberFormat = "#"
Workbooks("template.xls").Worksheets("Introduction").Cells(j, 21).NumberFormat = "#"
Workbooks("Cat export.xls").Worksheets("Items").Activate
If Left(Cells(i, 2), 13).Value = Workbooks("template.xls").Worksheets("Introduction").Cells(j, 21).Value Then
Workbooks("Cat export.xls").Worksheets("Items").Cells(i, 3) = Right(Workbooks("Cat export.xls").Worksheets("Items").Cells(i, 2), 5)
End If
Next
Next
The error is happening because you are not qualify all of your objects, so if any workbook or worksheet is active other than what you may expect, the code may not perform correctly.
It's best practice to always qualify objects in VBA and work directly with them.
See below:
Dim wbMyWB as Workbook, wbTemplate as Workbook
Set wbMyWB = Workbooks("myWB.xlsx") 'change as needed
Set wbTemplate = Workbooks("template.xls")
Dim wsMyWS as Worksheet, wsIntro as Worksheet
Set wsMyWS = wbMyWB.Worksheets("Sheet1") ' change as needed
Set wsIntro = wbTemplate.Worksheets("introduction")
'....
Dim rMyRange as Range, rIntro as Range
'assumes i and j are properly set to long or integer (or variant (hopefully not) type
'ideally i and j are both set to integer
rMyRange = wsMyWs.Cells(i,7)
rIntro = wsIntro.Cells(j,21)
rMyRange.NumberFormat = "#"
rIntro.NumberFormat = "#"
If Left(rMyRange,13).Value = rIntro.Value Then
'condition satisfied
End If
Related
I'm writing a code to loop through an excel sheet and changing the text (in column B) to uppercase/lowercase, depending on the value of cell in column N on the same row.
Macros purpose:
loop through cells in column B starting at row 2 and changing the string from upper to lowercase or vice versa, depending on the value of the cell in column N (lowercase if value = 5, other cases text should be uppercase)
Code I've got so far:
Sub CAPS()
'
' CAPS Macro
'
Dim Rang As Integer
Dim j As Integer
j = 2
For Each N In Source.Range("N2:N10000") ' Do 10000 rows
Rang = Cells(j, 14)
If Rang = 5 Then
Cells(j, 2).Range("A1").Select
ActiveCell.Value = LCase$(ActiveCell.Text)
Else
ActiveCell.Value = UCase$(ActiveCell.Text)
j = j + 1
End If
Next N
End Sub
I'm a little bit stuck in the looping part, not really a clue how to fix the error(s) in the current code.
Thanks in advance :)
Sub CAPS()
'
' CAPS Macro
'
Dim N as long 'use long here as integer is limite to a 32b character
For N Is 2 to 10000 ' Do 10000 rows
If Cells(N, 14) = 5 Then
Cells(N, 2) = LCase(Cells(N,2)
Else
Cells(N, 2) = UCase(Cells(N,2)
EndIf
Next N
End Sub
This should do the trick, untested though.
You currently have a fixed number of rows you want to test. To optimize your code you could first check how many rows are filled with data. To do so you can use:
DIM lastrow as long
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
And then make the loop with For N Is 2 to lastrow
Also it is good practice to explicitly reference your worksheets, as this prevents undesired results. For example you click on another worksheet whilst the code is running it will continue formatting on that sheet. To do so declare a variable as your worksheet:
DIM ws as worksheet
And set a value to your variable, in this case Sheet1.
Set ws as ThisWorkbook.Worksheets("Sheet1")
Now every time you reference a Cells(), you explicitly say on what sheet that has to be by adding ws. in front of it like such: ws.Cells()
To summarize all that into your code:
Sub CAPS()
'
' CAPS Macro
'
Dim N as long 'use long here as integer is limite to a 32b character
Dim lastrow as long
Dim ws as worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'Set the code to run on Sheet 1 of your current workbook.
lastrow = ws.Cells(Rows.Count, "B").End(xlUp).Row
For N Is 2 to lastrow ' Do all rows that have data in column B
If ws.Cells(N, 14) = 5 Then
ws.Cells(N, 2) = LCase(ws.Cells(N,2)
Else
ws.Cells(N, 2) = UCase(ws.Cells(N,2)
EndIf
Next N
End Sub
Try processing in an array,
Sub CAPS()
'
' CAPS Macro
'
Dim arr As variant, j As Integer
with worksheets("sheet1")
arr = .range(.cells(2, "B"), .cells(.rows.count, "B").end(xlup).offset(0, 12)).value2
for j= lbound(arr, 1) to ubound(arr, 1)
if arr(j, 13) = 5 then
arr(j, 1) = lcase(arr(j, 1))
else
arr(j, 1) = ucase(arr(j, 1))
end if
next j
redim preserve arr(lbound(arr, 1) to ubound(arr, 1), 1 to 1)
.cells(2, "B").resize(ubound(arr, 1), ubound(arr, 2)) = arr
end with
End Sub
You may try something like this...
Sub CAPS()
Dim ws As Worksheet
Dim lr As Long, i As Long
Application.ScreenUpdating = False
Set ws = Sheets("Sheet1") 'Sheet where you have to change the letter case
lr = ws.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To lr
Select Case ws.Cells(i, "N")
Case 5
ws.Cells(i, "B") = LCase(ws.Cells(i, "B"))
Case Else
ws.Cells(i, "B") = UCase(ws.Cells(i, "B"))
End Select
Next i
Application.ScreenUpdating = True
End Sub
Another approach using for each loop with Range:
Sub UCaseLCase()
Dim rng, cell As Range
Dim Test As Integer
Test = 5
Set rng = Range(Cells(2, 14), Cells(10000, 14))
For Each cell In rng.Cells
If cell.Value = Test Then
cell.Offset(0, -12) = LCase(cell.Offset(0, -12))
Else
cell.Offset(0, -12) = UCase(cell.Offset(0, -12))
End If
Next cell
End Sub
I know you said in your question starting at row 2 but it's easier just going from last row until row 2.
Hope this can help or at least, learn something new about Loops :)
Sub CAPS()
Dim j As Integer
For j = Range("B2").End(xlDown).Row To 2 Step -1
If Range("N" & j).Value = 5 Then
'uppercase
Range("B" & j).Value = UCase(Range("B" & j).Value)
Else
'lowercase
Range("B" & j).Value = LCase(Range("B" & j).Value)
End If
Next j
End Sub
I am trying to write a macro with some variables. Specifically worksheet names. Almost each time I have to find the correct worksheet name within the macro, so the worksheet names are coming from cell values. But referring a variable to another variable is giving an error.
Down below you can see the assign part of the codes. I am open to any suggestions.
Thank you so much..
Dim pLastRow As Long
Dim p As Integer
pLastRow = WorksheetFunction.Max(Worksheets(WS_All).Range("AA22:AA1100"))
pLastRow2 = pLastRow + 21
For p = 22 To pLastRow2
If Cells(p, 26).Value = "" Then
WS_1 = Worksheets(WS_All).Cells(p, 16).Value
WS_2 = Worksheets(WS_All).Cells(p, 19).Value
WS_3 = Worksheets(WS_All).Cells(p, 22).Value
End If
Dim j As Long
For j = 1 To 3
Dim j_WS As Variant
j_WS = "WS_" & j
MsgBox Worksheets(j_WS).Cells(1, 1).Value
o = 14 + j * 3
Dim WA1 As String
Dim WA2 As String
Dim WA3 As String
Gorev = Worksheets(WS_All).Cells(p, o).Value
SlideNo = Worksheets(WS_All).Cells(p, 34).Value
Egitim_Adi = Worksheets(WS_All).Cells(2, 3).Value
Dim Check1 As Range
Set Check1 = Worksheets(j_WS).Columns("A") 'Egitim_Adi Kontrolü için'
Dim Check2 As Range
Set Check2 = Worksheets(j_WS).Columns("B") 'SlideNo Kontrolü için'
Dim Check3 As Range
Set Check3 = Worksheets(j_WS).Columns("C") 'Gorev Kontrolü için'
I've found the solution with using array and using 3 cases for WS_1, 2 and 3.
I'm writing a VBA program.
I have a problem with finding this string [BLOCKED] in one column
For j = 0 To 4
For i = 2 To lastrow
If Cells(i, 12).Value = groupnames(j) And Cells(i, 8).Value Like "*" & "[BLOCKED]" & "*" Then
groupsum(j) = groupsum(j) + 1
End If
Next i
Next j
The problem is I have 96 cells for this string but the program found 500 how can I do this to going work?
Thanks for help
The syntax of your Like operation is incorrect. Use:
... Like "*[[]BLOCKED]*"
[...] is a Character class. So, the way you have it written in your question, it will find any single character in the set of BLOCKED. That is not what you want, apparently.
To match the [ character, you enclose it within a character class, as I have shown. To match the ] character, it must be outside of a character class.
here is my code
Sub blocked()
Dim SfileUsers As String
Dim path As String
Dim pathread As String
Dim sFileread As String
Dim lastrow As Long
Dim keres() As Variant
Dim groupadd() As String
Dim groupnames(4) As String
Dim groupsum(4) As Long
path = "C:\Users\uids9282\Desktop\"
SfileUsers = "Users.xlsx"
Workbooks.Open path & SfileUsers
Dim hossz As Long
hossz = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ReDim keres(hossz)
ReDim groupadd(hossz)
For i = 2 To hossz
keres(i) = Sheets(1).Cells(i, 2).Value
groupadd(i) = Sheets(1).Cells(i, 4).Value
Next i
'fájlmegnyitás
pathread = "C:\Users\uids9282\Desktop\20170703\"
sFileread = "open.xml"
If Dir(pathread & sFileread) = sFileread Then
Workbooks.Open pathread & sFileread
lastrow = Workbooks(sFileread).Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Else
MsgBox ("Nincs ilyen nevű excel táblázat. Kérem próbálkozzon újra")
End If
'groupok hozzáadása a fájlhoz
Dim user As String
For j = 2 To hossz
For i = 2 To lastrow
user = Trim(Cells(i, 5).Value)
If user = keres(j) Then
Cells(i, 12).Value = groupadd(j)
End If
Next i
Next j
'group szummázása és átírása
ThisWorkbook.Activate
For i = 2 To 6
groupnames(i - 2) = Cells(i, 1).Value
Next i
Workbooks(sFileread).Activate
For j = 0 To 4
For i = 2 To lastrow
If Cells(i, 12).Value = groupnames(j) And Cells(i, 8).Value Like "*[[]BLOCKED[]]*" Then 'itt van benne a hiba!! groupsum(j) = groupsum(j) + 1
End If
Next i
Next j
ThisWorkbook.Activate
For j = 2 To 6
Cells(j, 4).Value = groupsum(j - 2)
Next j
Workbooks(SfileUsers).Close SaveChanges:=False
Workbooks(sFileread).Close SaveChanges:=True
End Sub
this is my excel file where i want to searching
So here is what I'm trying to do. I have a sheet to parse Cisco router interface errors between snapshots to create a summary of how many packets and errors were on each interface. I have a button tied to a macro that executes this to copy just the summary itself.
x1 = Cells(2, 6).Value
y1 = Cells(3, 6).Value
x2 = Cells(4, 6).Value
y2 = Cells(5, 6).Value
ActiveSheet.Range(Cells(y1, x1), Cells(y2, x2)).Copy
Each of the cells listed have the value of row or column for the sections to be copied correctly. x2's cell is set based on how many interfaces so it can change the selected range.
My problem lies with wanting to copy this and the latest snapshot (which is in the cell directly above the summary section) together. I want to place the snapshot under the summary ideally when copied to the clipboard. To do this I've imagine I'll need to convert the range to a string then add both strings together and put it in the clipboard. However I can't even get the range to convert to something I can put in the clipboard. This is the code I'm using below which was found on here for converting a range to a string array and another for putting strings into the clipboard. However I can't figure out how to get the string array into the clipboard as it always errors out as 'Object required'. Any help would be appreciated.
x1 = Cells(2, 6).Value
y1 = Cells(3, 6).Value
x2 = Cells(4, 6).Value
y2 = Cells(5, 6).Value
' Get values into a variant array
Dim variantValues As Variant
variantValues = ActiveSheet.Range(Cells(y1, x1), Cells(y2, x2)).Value
' Set up a string array for them
Dim stringValues() As String
ReDim stringValues(1 To UBound(variantValues, 1), 1 To UBound(variantValues, 2))
' Put them in there!
Dim columnCounter As Long, rowCounter As Long
For rowCounter = UBound(variantValues, 1) To 1 Step -1
For columnCounter = UBound(variantValues, 2) To 1 Step -1
stringValues(rowCounter, columnCounter) = CStr(variantValues(rowCounter, columnCounter))
Next columnCounter
Next rowCounter
' Return the string array
RangetoStringArray = stringValues
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText RangetoStringArray.Value
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
I solved it with the tip off of Slai.
Sub CopyCompSnap()
x1 = Cells(2, 6).Value
y1 = Cells(3, 6).Value
x2 = Cells(4, 6).Value
y2 = Cells(5, 6).Value
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
ActiveSheet.Range(Cells(y1, x1), Cells(y2, x2)).Copy
DataObj.GetFromClipboard
On Error Resume Next
string1 = DataObj.GetText(1)
If Err.Number <> 0 Then
string1 = "Clipboard is Empty"
End If
ActiveSheet.Range("B5").Copy
DataObj.GetFromClipboard
On Error Resume Next
string2 = DataObj.GetText(1)
If Err.Number <> 0 Then
string2 = "Clipboard is Empty"
End If
strCopy = string1 & string2
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText strCopy
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub
I have an excel with two columns (B & C) - Business case and solution, there will be multiple business cases which might have same solution, i want to merge it based on solution. Something like below -
BC1 Sol1
BC2 Sol2
BC3 Sol2
BC4 Sol3
BC5 Sol4
BC6 Sol4
BC7 Sol4
output should be -
BC1 Sol1
BC2, BC3 Sol2
BC4 Sol3
BC5, BC6, BC7 Sol4
i would like to do this in VBA and tried something like below -
LASTROW = Range("C" & Rows.Count).End(xlUp).Row 'get last row
For I = 0 To LASTROW Step 1
For J = I + 1 To LASTROW Step 1
If Cells(I, "C") = Cells(J, "C") Then
Cells(I, "B") = Cells(I, "B") & "," & Cells(J, "B")
Rows(J).Delete
End If
Next
Next
the above works, but is very slow when running on 1000 rows, i went through other questions similar to this but not good in VBA to mod that for above one. Can someone please help ?
As you have commented, using a variant array rather than looping the cells directly will speed this up enormously
To apply that here you could:
Determine the source data range, and copy that into an array
Create another array to contain the new data
Loop the source array, testing for the required patterns, and populate the destination array
Copy the new data back to the sheet, overwriting the old data
Sub Demo()
Dim ws As Worksheet
Dim rng As Range
Dim datSrc As Variant
Dim datDst As Variant
Dim i As Long
Dim j As Long
Dim rwOut As Long
Dim str As String
Set ws = ActiveSheet
With ws
Set rng = Range(.Cells(1, 2), .Cells(.Rows.Count, 3).End(xlUp))
datSrc = rng.Value
ReDim datDst(1 To UBound(datSrc, 1), 1 To UBound(datSrc, 2))
rwOut = 1
For i = 1 To UBound(datSrc, 1)
str = datSrc(i, 1)
If datSrc(i, 2) <> vbNullString Then
For j = i + 1 To UBound(datSrc, 1)
If datSrc(i, 2) = datSrc(j, 2) Then
str = str & "," & datSrc(j, 1)
datSrc(j, 2) = vbNullString
End If
Next
datDst(rwOut, 1) = str
datDst(rwOut, 2) = datSrc(i, 2)
rwOut = rwOut + 1
End If
Next
rng = datDst
End With
End Sub