I want to multiply my range of cells by -1 when they matches the Instr criteria.
but I still get positive values, which are based on my else statement.
Basically, I use the ConverdDecimal function from this link:
https://www.extendoffice.com/documents/excel/1497-excel-convert-decimal-degrees-to-degrees-minutes-seconds.html
with doesn't cope well with negative values. Hence I have to modify my code.
Sub Sun()
Dim rng As Range, cell As Range, rngB As Range, rngC As Range
Dim wors As Worksheet
Dim myString As String
Set wors = ThisWorkbook.ActiveSheet
Dim lastRow As Long, LastRow2 As Long
wors.Columns("E").Copy
wors.Columns("P").PasteSpecial xlPasteValues
wors.Columns("F").Copy
wors.Columns("R").PasteSpecial xlPasteValues
lastRow = wors.Range("P" & wors.Rows.Count).End(xlUp).Row
LastRow2 = wors.Range("Q" & wors.Rows.Count).End(xlUp).Row
Set rng = wors.Range("P1:P" & lastRow)
Set rngB = wors.Range("R1:R" & lastRow)
Set rngC = wors.Range("F1:F" & lastRow)
For Each cell In rng
cell = WorksheetFunction.Substitute(cell, " ", "° ", 1)
cell = WorksheetFunction.Substitute(cell, " ", "' ", 2)
Next
For Each cell In rngB
cell = WorksheetFunction.Substitute(cell, "-", "")
cell = WorksheetFunction.Substitute(cell, " ", "° ", 1)
cell = WorksheetFunction.Substitute(cell, " ", "' ", 2)
Next
With words
Range("Q2:Q" & lastRow).Formula = "=ConvertDecimal(P2)"
Columns("Q").Copy
Columns("X").PasteSpecial xlPasteValues
Range("S2:S" & lastRow).Formula = "=ConvertDecimal(R2)"
End With
With rngC
If InStr(myString, "-") <> 0 Then
Range("T2:T" & lastRow).Formula = "=S2 * -1 "
Else
Range("T2:T" & lastRow).Formula = "=S2"
End If
End With
End Sub
I tried:
Range("T2:T" & lastRow).Formula = "=S2 * (-1) "
Range("T2:T" & lastRow).Formula = "=-S2"
Range("T2:T" & lastRow).Formula = "=-1 * S2"
Nothing works
What is wrong with my code? Why does it cove only the Else situation? I need negative formulas wherever the "-" appears in column F.
Is there any reason why this would not work: For cell T2 use the formula
=IF(LEFT(TRIM(F2), 1)="-", -1, 1)*S2
or if you want to do it in VBA
Range("T2:T" & lastRow).FormulaR1C1="=IF(LEFT(TRIM(RC6), 1)=""-"", -1, 1)*RC[-1]"
is it failing because of this typo and you do not have option explicit?
With words
words is not defined but wors is so if no option explcit a variable words is created at runtime but is set to nothing so nothing happens inside the with block
Related
I am trying use the declared range and apply it to an excel formula within the sheet.
Excel data is like this
Macro Code:
Sub VariableRange()
Set CodeRange = ActiveSheet.Range(Cells(2, 2), Cells(8, 2))
Set AmountRange = ActiveSheet.Range(Cells(2, 4), Cells(8, 4))
Set DateRange = ActiveSheet.Range(Cells(2, 5), Cells(8, 5))
Range("I5").FormulaR1C1 = "=SUMIFS(R2C4:R8C4,R2C2:R8C2,R[-2]C,R2C5:R8C5,R[-1]C)"
End Sub
is there a way for me to declare the range and or cells in a way like this?
Range("I5").Formula = "=SUMIFS(" & AmountRange & " ," & CodeRange & " ," & Range("I3") & " ," & DateRange & " ," & Range("I4") & " ,)"
Edit: Adjusted 2nd macro code
Writing SUMIFS Formula in VBA
Option Explicit
Sub VariableRange()
Const FirstRow As Long = 3 ' don't include headers
Const CodeColumn As String = "B"
Const DateColumn As String = "E"
Const AmountColumn As String = "D"
Const FindCodeCellAddress As String = "I3"
Const FindDateCellAddress As String = "I4"
Const FindAmountCellAddress As String = "I5"
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, CodeColumn).End(xlUp).Row
Dim CodeRange As Range
Set CodeRange = ws.Range(ws.Cells(FirstRow, CodeColumn), _
ws.Cells(LastRow, CodeColumn))
Dim DateRange As Range
Set DateRange = CodeRange.EntireRow.Columns(DateColumn)
Dim AmountRange As Range
Set AmountRange = CodeRange.EntireRow.Columns(AmountColumn)
ws.Range(FindAmountCellAddress).Formula = _
"=SUMIFS(" & AmountRange.Address & "," _
& CodeRange.Address & "," & FindCodeCellAddress & "," _
& DateRange.Address & "," & FindDateCellAddress & ")"
' Result in cell 'FindAmountCellAddress' if last row is 8:
' =SUMIFS($D$3:$D$8,$B$3:$B$8,I3,$E$3:$E$8,I4)
End Sub
I am using the function located here:
https://www.extendoffice.com/documents/excel/1497-excel-convert-decimal-degrees-to-degrees-minutes-seconds.html
in order to convert the degree min sec values to the decimal ones.
Unfortunately, I've encountered the problem.
I found that is not so simple as shown in this example:
Fill formula down till last row in column
in the other hand, the example more dedicated for my situation
Finding the Last Row and using it in a formula
also wans't successful.
I would like to know why I am getting:
the result to the second row only
the "#" character before by formula (as I can see in the bar).
What is wrong with my code then?
Sub Sun()
Dim rng As Range, cell As Range
Dim wors As Worksheet
Set wors = ThisWorkbook.ActiveSheet
Dim lastRow As Long, LastRow2 As Long
lastRow = wors.Range("P" & wors.Rows.Count).End(xlUp).Row
LastRow2 = wors.Range("Q" & wors.Rows.Count).End(xlUp).Row
Set rng = wors.Range("P1:P" & lastRow)
wors.Columns("E").Copy
wors.Columns("P").PasteSpecial xlPasteValues
For Each cell In rng
cell = WorksheetFunction.Substitute(cell, " ", "° ", 1)
Next
Call Degree
Range("Q2:Q" & lastRow).Formula = "=ConvertDecimal (P" & LastRow2 & " )"
End Sub
Moreover, it comes to an error:
Invalid procedure call or argument
, with debugging:
xDeg = Val(Left(pInput, InStr(1, pInput, "°") - 1))
the code from the function:
Function ConvertDecimal(pInput As String) As Double
'Updateby20140227
Dim xDeg As Double
Dim xMin As Double
Dim xSec As Double
xDeg = Val(Left(pInput, InStr(1, pInput, "°") - 1))
xMin = Val(Mid(pInput, InStr(1, pInput, "°") + 2, _
InStr(1, pInput, "'") - InStr(1, pInput, _
"°") - 2)) / 60
xSec = Val(Mid(pInput, InStr(1, pInput, "'") + _
2, Len(pInput) - InStr(1, pInput, "'") - 2)) _
/ 3600
ConvertDecimal = xDeg + xMin + xSec
End Function
How can I drag this formula down to the last row?
Your order is a little off, fill P before trying to find the last row.
Also finding the last row in Q is not needed.
Sub Sun()
Dim rng As Range, cell As Range
Dim wors As Worksheet
Set wors = ThisWorkbook.ActiveSheet
Dim lastRow As Long
wors.Columns("E").Copy
wors.Columns("P").PasteSpecial xlPasteValues
lastRow = wors.Range("P" & wors.Rows.Count).End(xlUp).Row
Set rng = wors.Range("P1:P" & lastRow)
For Each cell In rng
cell = WorksheetFunction.Substitute(cell, " ", "° ", 1)
cell = WorksheetFunction.Substitute(cell, " ", "' ", 2)
Next
Range("Q2:Q" & lastRow).Formula2 = "=ConvertDecimal(P2)"
End Sub
But I would use variant arrays to speed it up a little:
Sub Sun()
Dim rng As Variant, cell As Range
Dim wors As Worksheet
Set wors = ThisWorkbook.ActiveSheet
Dim lastRow As Long
lastRow = wors.Range("E" & wors.Rows.Count).End(xlUp).Row
rng = wors.Range("E1:E" & lastRow).Value
Dim outArray() As Variant
ReDim outArray(1 To UBound(rng, 1), 1 To 2)
outArray(1, 1) = rng(1, 1)
outArray(1, 2) = "Output"
Dim i As Long
For i = 2 To UBound(rng, 1)
rng(i, 1) = WorksheetFunction.Substitute(WorksheetFunction.Substitute(rng(i, 1), " ", "' ", 2), " ", "° ", 1)
outArray(i, 1) = rng(i, 1)
outArray(i, 2) = ConvertDecimal(CStr(rng(i, 1)))
Next
wors.Range("P1").Resize(UBound(outArray, 1), 2).Value = outArray
End Sub
Sub PullUniques()
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Dim rngCell As Range
For Each rngCell In Range("A1:A" & LastRowColumnA)
If WorksheetFunction.CountIf(Range("B1:B" & LastRowColumnA), rngCell) <> 0 And _
Range(WorksheetFunction.CountIf(Range("B1:B" & LastRowColumnA), rngCell) <> 0).Offset(0, 1).Row <= 0 Then
MsgBox "Please correct Item" & rngCell & " Amount Data"
End If
Next
This code is looking up Column B to see if column A has any same values.
The code works fine if I do not use second line of if statement, but when I tried to add second condition column A is matching B and column C's value is not greater than 0, it does not work. How can I make this code work?
I think you are trying to check,
1) if the value in A exist in column B and
2) if TRUE, is the value in column C less than or equal to 0.
If that's what you need, the code below should work.
Sub PullUniques()
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Dim rngCell As Range
For Each rngCell In Range("A1:A" & LastRowColumnA)
If WorksheetFunction.CountIf(Range("B1:B" & LastRowColumnA), rngCell) <> 0 And _
Range("C" & rngCell.Row).Value <= 0 Then
MsgBox "Please correct Item" & rngCell & " Amount Data"
End If
Next
End Sub
However, if your condition is,
1) if the value in A the same as value in B and
2) if TRUE, is the value in column C less than or equal to 0.
then you don't need to use countif
Sub PullUniques()
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Dim rngCell As Range
For Each rngCell In Range("A1:A" & LastRowColumnA)
Debug.Print Range("B" & rngCell.Row).Value & "/" & Range("C" & rngCell.Row).Value
If Range("B" & rngCell.Row).Value = rngCell And _
Range("C" & rngCell.Row).Value <= 0 Then
MsgBox "Please correct Item" & rngCell & " Amount Data"
End If
Next
End Sub
I have an excel sheet which need do format the data
I need to format this data like this in different sheet
Note - This a small sample I created for your understanding
my test macro is below. If you want to use it, you just need to rename your sheets - "DataSheet" for the one with the data and "ResultSheet" where the result will be stored.
Sub Reformat()
Dim letter As String
Dim iRow As Integer
Dim rng As Excel.Range
Sheets("ResultSheet").Range("A1:A" & Range("A1").End(xlDown).Row).Value = Range("A1:A" & Range("A1").End(xlDown).Row).Value
Sheets("ResultSheet").Select
Range("A1:A" & Range("A1").End(xlDown).Row).RemoveDuplicates Columns:=1, Header:=xlNo
Set rng = Range("A1:A" & Range("A1").End(xlDown).Row)
For i = 1 To Sheets("DataSheet").Range("A1").End(xlDown).Row
letter = Sheets("DataSheet").Range("A" & i).Value
iRow = WorksheetFunction.Match(letter, rng)
If Range("B" & iRow).Value = "" Then
Range("B" & iRow).Value = Sheets("DataSheet").Range("B" & i).Value
Else
Range("A" & iRow).End(xlToRight).Offset(0, 1).Value = Sheets("DataSheet").Range("B" & i).Value
End If
Next i
End Sub
I am using .find to search the entire workbook and displaying results with a hyperlink to the match. But since the searched word can be found in any column I need to know which column the word is found in to make the search result appear correct.
This is my code as it is today, I am using a slightly modified example that I found:
Sub Set_Hyper()
' Object variables
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String
' {i} will act as our counter
Dim i As Long
' Use an input box to type in the search criteria
Dim MyVal As String
MyVal = ActiveSheet.Range("D9")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
i = 19
' Begin looping:
' We are checking all the Worksheets in the Workbook
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> "Start" Then
' We are checking all cells, we don't need the SpecialCells method
' the Find method is fast enough
With wks.Range("A:B")
' Using the find method is faster:
' Here we are checking column "A" that only have {myVal} explicitly
Set rCell = .Find(MyVal, , , xlPart, xlByColumns, xlNext, False)
' If something is found, then we keep going
If Not rCell Is Nothing Then
' Store the first address
fFirst = rCell.Address
Do
' Link to each cell with an occurence of {MyVal}
rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Value
wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 5)
Set rCell = .FindNext(rCell)
i = i + 1 'Increment our counter
End If
Loop While Not rCell Is Nothing And rCell.Address <> fFirst
End If
End With
End If
Next wks
' Explicitly clear memory
Set rCell = Nothing
' Reset application settings
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I'm thinking that I want to add something like this:
If rCell.Column() = A Then
' Link to each cell with an occurence of {MyVal}
rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Value
wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 5)
Set rCell = .FindNext(rCell)
i = i + 1 'Increment our counter
End If
If rCell.Column() = B Then
' Link to each cell with an occurence of {MyVal}
rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell(0, -1).Address, TextToDisplay:=rCell(0, -1).Value
wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 5)
Set rCell = .FindNext(rCell)
i = i + 1 'Increment our counter
End If
Problem is that it doesn't work the way I want. I've tried to modify it in some ways, but either it just seems to skip the whole If part or I never get a result at all.
Can't I use the column comparison this way, or what is the problem?
Use something like this for Column A, where the column is defined by its position (1) rather than a letter (A). As you are searching a two column range A:B then
If rCell.Column = 1 Then
`do code for A
Else
`do code for B
End If
Based on the code sample you pasted, it appears you can simply offset directly based on the column number:
' Link to each cell with an occurence of {MyVal}
rcell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rcell.Offset(, 1 - rcell.Column).Address, TextToDisplay:=rcell.Offset(, 1 - rcell.Column).Value
wks.Range("B" & rcell.Row & ":R" & rcell.Row).Copy Destination:=Cells(i, 5)
Set rcell = .FindNext(rcell)
i = i + 1 'Increment our counter
End If