Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 6 years ago.
Improve this question
I'm writing a makro formatting all non-numeric cells to text before loading to database. I have a line that I have no idea what's wrong with. My VBA skills are poor. I get run-time error '424'.
Sub formatAllCellsAsText()
Dim wsTemp As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
For sht = 3 To Worksheets.Count
Set wsTemp = Sheets(sht)
Set StartCell = Range("A4")
LastRow = wsTemp.Range("A1").CurrentRegion.Rows.Count
LastColumn = wsTemp.Range("A1").CurrentRegion.Columns.Count
For Each Cell In wsTemp.Range(StartCell, wsTemp.Cells(LastRow, LastColumn)).Cells
If Not IsEmpty(Cell.Value) And IsNumeric(Cell.Value) And InStr(wsTemp.Cells(1, Cell.Column), "Client ID") <= 0 Then
Dim Temp As Double
Temp = Cell.Value
Cell.ClearContents
Cell.NumberFormat = "#"
Cell.Value = CStr(Temp)
End If
Next
Next sht
End Sub
Set StartCell = Range("A4")
should be
Set StartCell = wsTemp.Range("A4")
Just want to summarize as I probably found the issue.
In my first code posted I did not set Cell variable that I was later referring to. I thought that Cell would be self-explanatory for VBA.
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 12 months ago.
Improve this question
I have 500 value in column A and 200 value in column B. I need to check that column A values are present in column B. if value is found then need to highlight that founded value.
This is my attempt. Your questions is pretty vague though, so there are a few assumptions. Good luck!
Sub compareColumns()
' im assuming the sheet in question is the index 1 sheet in the workbook
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
' im assuming no header
Dim lastRowA As Integer: lastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim lastRowB As Integer: lastRowB = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
Dim i As Integer, j As Integer
Dim matchMe As String
For i = 1 To lastRowA
matchMe = ws.Cells(i, 1).Value
For j = 1 To lastRowB
If ws.Cells(j, 2).Value = matchMe Then
ws.Cells(i, 1).Interior.Color = vbRed
Exit For
End If
Next j
Next i
End Sub
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 3 years ago.
Improve this question
I have an excel, which as a long line in a single cell(For example in "A1" in Sheet1) and I need to split this single cell and paste into different consecutive cell in Sheet1 itself in a cells A1,A2,A3 ., so on. But the challenge is that I have the delimiter values in another sheet(Sheet2).
Single cell("A1") line in Sheet1 is,
2012-06-02-13.01.29.64179044558000358307267 CAB2019012018 12345612345678Scenario 1 0000000000000000000000000000000000DoeNN
And the delimiters are in Sheet2(delimiters values are in different consecutive cells),
4(A1),5(A2),6(A3),2(A4),3(A5),5(A6),6(A7),1(A8),5(A9),7(A10),5(A11),9(A12)
I tried with below code,
Sub split_work()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cell_value As Variant
Dim counter As Integer
Dim WrdArray() As String
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
With ws1
str = ws1.Cells(i, j).Value
MStr = ws2.Cells(Lengthrow, j).Value
'MStr = Left(str, MStr)
''These lines is to extract only the value from the cells in Sheet2 as a delimiter value, for example val=4, then we are extracting only 4 as delimiters,
MStr = Cells(Lengthrow, j).Value
MStr1 = InStrRev(MStr, "=")
Length = Len(MStr)
Mstr = Right(MStr, Length - MStr1)
For Each Item In WrdArray
ThisWorkbook.ActiveSheet.Cells(counter, 2).Value = Item
counter = counter + 1
Next Item
End with
End sub
Please help me with this!
I think something like this might work for you.
Sub split_work()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim pStr As String
Dim delimiter As String
Dim counter As Integer
Dim lStr As Integer
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
pStr = ws1.Range("A1")
delimiter = ws2.Range("A1")
counter = 0
Do While delimiter <> ""
dpos = InStr(pStr, delimiter)
ws1.Range("A1").Offset(counter, 1) = Left(pStr, dpos)
lStr = Len(pStr)
pStr = Right(pStr, lStr - dpos)
counter = counter + 1
delimiter = ws2.Range("A1").Offset(counter, 0)
Loop
If pStr <> "" Then
ws1.Range("A1").Offset(counter, 1) = pStr
End If
End Sub
I'm not sure if you are using those values as delimiters or positions for splitting in your string. I've assumed you are wanting to split the string when the code finds that substring.
Also, do you want to include or exclude that value from the string? In the above code I have included that value, please provide more information in your question so I can better answer your question.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
I have two workbooks. A source Workbook(1) and an Destination Workbook(2).
I am copying all the Contents from 1 to 2.
I have the below code running for this.
I have a small problem with the workbook.
I have my source book with pictures in it , Like the picture below.
I have included the column to be copied in my code. but I don't get those pictures. Could someone tell me how I can copy these pictures with the contents to my destination sheet, with the below code.
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
ThisWorkbook.Sheets("2").Range("A4:P1000").ClearContents
CopyCol = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LCell = Selection.SpecialCells(xlCellTypeLastCell).Address
LCC = Selection.SpecialCells(xlCellTypeLastCell).Column
LCR = Selection.SpecialCells(xlCellTypeLastCell).Row
Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies)
Set x = Workbooks.Open("D:\Jenny\Raw data\Report.xlsx")
For Count = 0 To UBound(CopyCol)
Set temp = Range(CopyCol(Count) & "22:" & CopyCol(Count) & LCR)
If Count = 0 Then
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("2").Range("A4").PasteSpecial
x.Close
End Sub
Could someone suggest, how I can copy those picture with the content to the destination workbook.
Instead of
y.Sheets("2").Range("A4").PasteSpecial
try
y.Sheets("2").Paste y.Sheets("2").Range("A4")
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 7 years ago.
Improve this question
In sheet1 I have one cell A3 (52):
In the sheet 2, I want to delete the row where there is the number of A3 of the sheet 1. This number can only be in the first column.
Here is my code, but it doesn't work:
Sub delete_ligne()
Dim i As Integer
Application.ScreenUpdating = False
For i = 1 To 6600
If (Cells(i,1) = ThisWorkbook.Sheets("Modification").Range("B7").Value)
Then
Cells(i, 1).EntireRow.Delete
i = i - 1
End If
Next
Application.ScreenUpdating = True
End Sub
Any solution?
Still not sure what "It doesn't work" means, but this might help:
Sub delete_ligne()
Dim rng as Range
Dim WB as Workbook
Dim i As Integer
Application.ScreenUpdating = False
Set WB = 'define your workbook here
Set rng = WB.Sheet(2).Range("B:B").Find (What:=WB.Sheet(1).Range("A3"), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
While not Rng is Nothing
rng.Rows(1).EntireRow.Delete
Set rng = WB.Sheet(2).Range("B:B").Find (What:=WB.Sheet(1).Range("A3"), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
Wend
Application.ScreenUpdating = True
End Sub
Adjust to define WB, Sheet(2), and Sheet(1) as necessary to point to the correct locations.
The .Find will be substantially faster than looping 6600 rows and doesn't care what order it finds/deletes the rows.
You can add an outer loop if there are more cells to be checked that "A3"
If I understand the question correctly ;
Dim wbThis As Workbook
Dim wsThis As Worksheet
Dim wsTarget As Worksheet
Dim tmp As Integer
Sub delete_ligne()
Set wbThis = ActiveWorkbook
Set wsThis = wbThis.Sheets(1)
Set wsTarget = wbThis.Sheets(2)
For i=1 To 100
wsThis.Activate
tmp = wsThis.Cells(3, i).Value
For j=3 To 100
wsTarget.Activate
If Cells(j,1).Value = tmp Then
Cells(j,1).EntireRow.Delete
End If
Next j
Next i
End Sub
First Loop (i) :
First For Loop is looping through the cells of the Sheet 1. It starts from A3 and goes until A100. You can tweak the values in the code.
Second Loop (j) :
Second For Loop is looping through the cells of the Sheet 2 for each element of the First Loop. If any value is it deletes the row entirely.
Something like this should work...
Just double check which cell actually has your value as your code and question don't agree.
Sub delete_ligne()
Dim i As Integer
Application.ScreenUpdating = False
For i = 6600 To 1 Step -1
If Cells(i,1) = ThisWorkbook.Sheets("Modification").Range("A3").Value Then
Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 9 years ago.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Questions concerning problems with code you've written must describe the specific problem — and include valid code to reproduce it — in the question itself. See SSCCE.org for guidance.
Improve this question
Can you please let me know how I can remove all formulas from a sheet but keep the results of calculations in excel VBA?
I have a sheet called map which has lots of calculation columns there now I would like to remove all of this formulas but still keep the result to save into a new sheet.
Way 1 (Courtesy #rdhs)
Sub Sample()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("DTMGIS")
ws.UsedRange.Value = ws.UsedRange.Value
End Sub
Way 2 Using Copy - PasteSpecial - Values
Sub Sample()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("DTMGIS")
With ws.UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
End Sub
Way 3 Using SpecialCells
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Sheets("DTMGIS")
On Error Resume Next
Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rng Is Nothing Then
rng.Value = rng.Value
End If
End Sub