I need help. Is it possible to import a data from one sheet to another but the data I'm trying to import should be substracted from a tab of the original sheet?
The formula should look like this:
=(importrange("https://LINKHERE","JAN!j18")).
Now the data on J18 is what I'm trying to import but it is being added from Jan!j18. I'm trying to put this to Feb!j18 (but wants to exclude the added data from Jan!18. It was added intentionally to feb but the other sheet needs a monthly numbers only. Any help please?
Sorry, I don't quite follow your problem.
But if you import a range into an array, you can then loop through it and manipulate it
Sub test1()
arr1 = Range(Worksheets(1).Cells(1, 1), Worksheets(1).Cells(4, 3))
'Note, that the array will start at 1, rather than 0.
For iRow = 1 To UBound(arr1, 1)
For iCol = 1 To UBound(arr1, 2)
'Which is convenient as we're pasting back to a workbook
Worksheets(2).Cells(iRow, iCol) = arr1(iRow, iCol) + 10
Next iCol
Next iRow
End Sub
Do pay attention to the array indices - as going to and from ranges & workbooks is abnormal relative to usual array use
Related
I am writing a VBA script to check all measuring point, who are part of the selection have inspection orders. For this I need to extract a large amount of measering point (ca. 2721) and use them as an input in another transaction.
The problem I have is: What is the most efficient way to extract / export a large amount of data from SAP in a way that I can paste them as an input in SAP?
I can make an export, but I cannot access the exported Excel-file through VBA. I can loop through the datarows and copy every single cell, but this is very slow, as shown below.
row = 1
For i = 1 To session.FindById("wnd[0]/usr/cntlGRID1/shellcont/shell").RowCount - 2
session.FindById("wnd[0]/usr/cntlGRID1/shellcont/shell").CurrentCellRow = i
ThisWorkbook.Sheets("Output2").Cells(row, 1) = session.FindById("wnd[0]/usr/cntlGRID1/shellcont/shell").GetCellValue(i - 1, "TPLNR")
ThisWorkbook.Sheets("Output2").Cells(row, 2) = session.FindById("wnd[0]/usr/cntlGRID1/shellcont/shell").GetCellValue(i - 1, "POINT")
row = row + 1
Next
You should
use an array - instead of writing directly to the sheet
use with to not call session.FindByID... multiple times
Dim arrData As Variant, i As Long
With session.FindById("wnd[0]/usr/cntlGRID1/shellcont/shell")
ReDim arrData(1 To .RowCount - 2, 1 To 2)
For i = 1 To .RowCount - 2
.CurrentCellRow = i
arrData(i, 1) = .GetCellValue(i - 1, "TPLNR")
arrData(i, 2) = .GetCellValue(i - 1, "POINT")
Next
End With
With ThisWorkbook.Sheets("Output2")
.Resize(UBound(arrData, 1), 2).Value = arrData
End With
But maybe it's worth to look into Powerquery to achieve what you want.
This is a sample of K4 L4
[![enter image description here][2]][2] This is a sample of K63
So again I want to arrange each worksheet in the workbook based on the values in K4, L4 and than K63
Hello I'm looking for a code that will sort the worksheets in the workbook based on multiple cell values. First I will like to sort all worksheets in the workbook based on K4 (text Ascending Order) than by L4 (text Ascending Order) and finally by cell k63 (value greatest to least). I'm struggling with the logic piece on how to make it vba go in sequence. Any insight will be greatly appreciated.
I hid rows and delete sensitive data. But from the screen shot you can basically get the jist of how I would like the worksheets arranged
The following code shows how you could achieve this:
Create an array of objects that hold the information for every sheet, including the sheet name itself
Sort the array according to your needs. I have used a simple bubble sort as it is fast enough for 100 records - but if you want, feel free to look for more efficient sort algorithms, plenty around here on SO and elsewhere. The key of sorting is that you have a custom compare method that returns -1 if object 1 is "smaller" (needs to be sorted to the left) and 1 if it is "larger" - very similar to the strComp-method in VBA.
After sorting, use the sheet names of the sorted array to rearrange the sheets.
Create a class module and name it clsSheetData that holds the information needed for sorting.
Public sheetname As String
Public gmo As String
Public ovp As String
Public percent As Double
Create a regular module with the code (I assume you want to sort ThisWorkbook, else pass the workbook as parameter)
Sub SortSheets()
' Define the array
ReDim arr(1 To ThisWorkbook.Sheets.Count) As clsSheetData
' - - Step 1: Build array with data
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Set arr(ws.Index) = New clsSheetData
arr(ws.Index).sheetname = ws.Name
arr(ws.Index).gmo = ws.Range("K4")
arr(ws.Index).ovp = ws.Range("L4")
arr(ws.Index).percent = ws.Range("K63")
Next
' - - Step 2: Sort Array (Bubblesort)
Dim i As Long, j As Long
For i = 1 To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If sheetCompare(arr(i), arr(j)) > 0 Then
Dim Temp As clsSheetData
Set Temp = arr(j)
Set arr(j) = arr(i)
Set arr(i) = Temp
End If
Next j
Next i
' - - Step3: Rearrange sheets
For i = 1 To UBound(arr)
With ThisWorkbook
.Sheets(arr(i).sheetname).Move before:=.Sheets(i)
End With
Next
End Sub
Function sheetCompare(o1 As clsSheetData, o2 As clsSheetData) As Integer
' Compare the data of 2 sheets.
If o1.gmo <> o2.gmo Then ' If gmo is different, use that as criteria
sheetCompare = StrComp(o1.gmo, o2.gmo, vbTextCompare)
ElseIf o1.ovp <> o2.ovp Then ' Else If ovp is different, use that as criteria
sheetCompare = StrComp(o1.ovp, o2.ovp, vbTextCompare)
Else ' Else, compare percentage
sheetCompare = IIf(o1.percent > o2.percent, -1, 1)
End If
End Function
I want to mark a graph based on filtered datas. Unfortunately my code is using ALL datas instead of the filtered data, sothat the mapping wrong.
For the marking I want to use the first letter of the second and third column. The data starts at row number three. Can you tell me a solution to use only the visible data?
Sub BeschriftungDiagramm()
Dim lngPunkt As Long
Dim data As Worksheet
Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
.ApplyDataLabels
For lngPunkt = 1 To .Points.Count
.Points(lngPunkt).DataLabel.Text = Left(data.Cells(lngPunkt + 2, _
2), 1) & " " & Mid(data.Cells(lngPunkt + 2, 3), 2, 1)
Next lngPunkt
End With
End Sub
I hope you got enough information to understand my problem. Thank you in advance :)
I'm working with an Excel report in which each month a new worksheet is added. Each row in the worksheet is for an employee, and the columns in that row is data related to them. Each week, the rows may vary, with names being added and removed.
I wrote the following VBA module to align the rows of 2 worksheets, adding blank rows as necessary, but I need to figure out a way to expand that so it aligns 12 worksheets, with multiple blank spaces between names as necessary. I'm not sure how to go about this, any suggestions?
Option Explicit
Sub Align()
Dim n As Long, a As Range, c As Range, x As Long
n = Cells.SpecialCells(11).Row
Set a = Worksheets("Jan").Range("A6:A200"): Set c = Worksheets("Feb").Range("A6:A200")
a(n + 1) = Chr(255): c(n + 1) = Chr(255)
a.Sort a(1), 1, Header:=xlNo
c.Sort c(1), 1, Header:=xlNo
Do
x = x + 1
If a(x) > c(x) Then
a(x).EntireRow.Insert xlShiftDown
ElseIf a(x) < c(x) Then
c(x).EntireRow.Insert xlShiftDown
End If
If x > 10 ^ 4 Then Exit Do
Loop Until a(x) = Chr(255) And c(x) = Chr(255)
a(x).ClearContents: c(x).ClearContents
End Sub
I do not believe any simple rearrangement of your existing code will meet your needs. I also believe this is too big a question to expect anyone to create an entire macro for you.
Below I outline the approach I would take to solving your problem. I suggest you try to solve each issue in turn. None of the code I give has been tested so I doubt it is error-free. Debugging my code should help you understand it. If you run into difficulties, you can come back to me with questions. However, it would be better to attempt to construct a new question including the code you cannot get working. With a single issue question, I believe you will get help more quickly than waiting for me to log in.
I hope this helps.
Issue 1 - Identifying the 12 worksheets
If the workbook only contains the 12 worksheets "Jan", "Feb" ... "Dec", then it is easy: worksheets 1 to 12. It does not matter if they are in the wrong sequence.
If the workbook contains other worksheets that are the first few worksheets of the workbook then it will be almost as easy: N to N+11.
If the other worksheets and the month worksheets are muddled, you will have to access then using an approach like this:
Dim InxMonth As Long
Dim InxWsht As Long
Dim WshtMonthName() As Variant
WshtMonthName = Array("Jan", "Feb", ... "Dec)
For InxMonth = 0 to 11
InxWsht = WshtMonthName(InxMonth)
With Worksheets(InxWsht)
:::::::
End with
Next
It might be better to use this approach anyway in case a user adds a new worksheet. This technique will work regardless of what other worksheets may exist.
Issue 2 - Get sorted list of names
You need a list in alphabetic order containing every name that appears in any worksheet. I can think of a number of approaches. I was taught: get the code working then make it faster, smoother or whatever. I have picked an approach that I think is easy to implement. Other approaches would be faster to execute but it does not sound as though you will be executing the code very often and there are only 12 worksheets. Your taking hours to debug complex code that will shave a few seconds off the run time is not a good use of your time.
Issue 3 - Sort the worksheets
You have code to sort a single worksheet. You need to put that code in a loop which you execute for each of the month worksheets.
Issue 4 - Create list of names
This approach is not very elegant and I can think of much faster approaches. However I think it is easy to understand what this code is doing.
I have initialised NameList to 200 entries because your code seem to assume that there are fewer than 200 employees. However the code enlarges the array if necessary.
Dim InxNameCrntMax as Long
Dim InxMonth As Long
Dim InxWsht As Long
Dim NameList() As String
Dim NextLowestName As String
Dim RowCrnt As Long
Dim WshtRowCrnt() As Long
ReDim NameList(6 to 200) ' 6 is first data row
InxNameCrntMax = 0
ReDim WshtRowCrnt(0 To 11)
' For each worksheet set the current row to the first data row
For InxMonth = 0 to 11
WshtRowCrnt(InxMonth) = 6
Next
Do While True
' Loop until every name in every worksheet has been added to NameList
NextLowestName = "~" ' Greater than any real name
' Examine the next row in each worksheet and find the lowest name
For InxMonth = 0 To 11
With Worksheets(WshtMonthName(InxMonth))
RowCrnt = WshtRowCrnt(InxMonth) ' Get next row for current worksheet
If .Cells(RowCrnt, "A") <> "" Then
' Not all names from current worksheet added to NameList
If NextLowestName > .Cells(RowCrnt, "A") Then
' This name comes before previous next lowest name
NextLowestName = .Cells(RowCrnt, "A")
End If
End If
End With
Next
If NextLowestName = "~" Then
' All names from all worksheets added to NameList
Exit Do
End If
' Add NextLowestName to NameList
InxNameCrntMax = InxNameCrntMax + 1
If InxNameCrntMax > UBound(NameList) Then
' NameList is full so enlarge it
ReDim Preserve NameList(6 To UBound(NameList) + 100)
End If
NameList(InxNameCrntMax) = NextLowestName
' Step the current row for every worksheet containing NextLowestName
For InxMonth = 0 To 11
With Worksheets(WshtMonthName(InxMonth))
RowCrnt = WshtRowCrnt(InxWsht) ' Get next row for current worksheet
If .Cells(RowCrnt, "A") = NextLowestName Then
WshtRowCrnt(InxWsht) = RowCrnt + 1
End If
End With
Next
Loop
Issue 5 - Using NameList
I initialised the size of NameList to (6 To 200) although it may have been enlarged so it could now be (6 To 300) or (6 To 400).
VBA is one of the few languages that does not require the lower bound of an array to be 0. It is worth taking advantage of this feature. I understand from your code that 6 is the first data row of the worksheets. That is why I set the lowest bound to 6; it means the element numbers match the row numbers.
InxNameCrntMax is the last used entry in NameList so we have something like:
NameList(6) = "Aardvark, Mary"
NameList(7) = "Antelope, John"
NameList(8) = "Bison, Jessica"
::::::
NameList(InxNameCrntMax) = "Zebra, Andrew"
So if for Worksheets("Jan") there is no Mary Aardvark, row 6 should be empty. If there is a John Antelope, his data belongs on row 7.
In your code, you use InsertRow to insert blank lines. I do not really like updating worksheets in situ because, if you mess up, you have to reload the data from a backup copy.
I would rather build worksheet "JanNew" from Jan", "FebNew" from "Feb" and so on. When all these new worksheets had been created, I would rename "Jan" to "JanOld" and so on and then I would rename "JanNew" to "Jan" and so on. Only when I was absolutely convinced I had moved the data correctly would I delete the old worksheets.
However, I have to admit your approach is easier. I leave you to decide what to do.
I've pieced together a macro to allow me to calculate the cost of a story task by calculating the specific rate based on the developer assigned. I have the rate table on a second sheet. I am able to get a result for the cell that the macro is set to (Row 2), but want it to run on all rows. I know I have to set a generic range, but am not sure. How should I change the range declare to run on all rows?
Here is the code:
Sub GetCost()
Range("D2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
Dim Estimate As Integer, Assignee As String, RodRate As Integer, GarthRate As Integer, DerekRate As Integer, TotalCost As Integer
Estimate = ThisWorkbook.Worksheets("Sheet1").Range("D2").Value
Assignee = ThisWorkbook.Worksheets("Sheet1").Range("E2").Value
RodRate = ThisWorkbook.Worksheets("Sheet2").Range("B2").Value
GarthRate = ThisWorkbook.Worksheets("Sheet2").Range("B3").Value
DerekRate = ThisWorkbook.Worksheets("Sheet2").Range("B4").Value
If Assignee = "Rod" Then
TotalCost = Estimate * RodRate
ElseIf Assignee = "Garth" Then
TotalCost = Estimate * GarthRate
ElseIf Assignee = "Derek" Then
TotalCost = Estimate * DerekRate
Else
TotalCost = "0"
End If
ThisWorkbook.Worksheets("Sheet1").Range("F2").Formula = TotalCost
ActiveCell.Offset(1, 0).Select
Loop
End Sub
I have rewritten your code with explanations which I hope are enough for you to understand why. There is much more that I could say. I hope this is a good balance between too little and too much.
However, I have to point out that there are some excellent project management tools available. I do not believe this is a good use of your time.
Random points
On 32-bit computers, Long is better than Integer.
Do not declare your variables inside a loop. The scope of a variable declared inside a sub-routine is the
the sub-routine so declare them at the top of the sub-routine.
You can declare all your variables in a single Dim statement but I find it confusing unless there is a real association between two or more variable. I might have:
Dim RodRate As Long, GarthRate As Long, DerekRate As Long
because these variables are associated. However the trouble with this approach is that you will have to add MaryRate and JohnRate and AngelaRate when these people join your project.
You need an array:
Dim PersonRate(1 To 3) As Long
where PersonRate(1) = Rate for Rod, PersonRate(2) = Rate for Garth and PersonRate(3) = Rate for Derek.
But this is hardly any better. You want a table that can grow. So today:
Name Rate
Rod 20
Garth 25
Derek 15
Next week:
Name Rate
Rod 20
Garth 25
Derek 15
Mary 30
With this, you pick up the Assignee's name, run down the table until you find their name then look across for their rate.
I assume you have a table like this in Sheet2. You could keep going back to Sheet2 but better to load the table into an array.
We could have:
Dim PersonName() As String
Dim PersonRate() As Long
so PersonRate(2) gives the rate for PersonName(2).
Note in my first array declaration I wrote: PersonRate(1 To 3). This time, the brackets are empty. With PersonRate(1 To 3), I am saying I want exactly three entries in the array and this cannot be changed. With PersonRate(), I am saying I want an array but I will not know how many entries until run time.
I said we could have two arrays, PersonName() and PersonRate() and this is what I have done. This is an easy-to-understand approach but I do not think it is the best approach. I prefer structures. When you have got this macro working and before you start your next look up User Types which is the VBA name for a structure.
Consider:
With Sheets("Sheet2")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
End With
There is a lot to explain here.
Cells means I want to address a cell within the active workbook. .Cells means I want to address a cell within the sheet identified in the With statement. This means I do not have to select Sheet1 or Sheet2 to look at their contents. Selecting worksheets is slow and the code tends to be more difficult to understand.
.Cells(Row, Column) identifies a cell. Row must be a number but column can be a number or a column code: A=1, B=2, Z=26, AA=27, etc.
Rows.Count returns the number of rows in a sheet for the version of Excel you are using. So .Cells(Rows.Count, "A") identifies the bottom of column "A".
End(xlUp) is the VBA equivalent of clicking Ctrl+UpArrow. If you are not familar with Ctrl+Arrow I suggest you play with these four controls. Note, these controls give easy to understand results with a rectangular table. However, if there are empty cells, the results can be strange.
Putting this together: .Cells(Rows.Count, "A").End(xlUp).Row means start at the bottom of column A, go up until you hit a cell with a value and return its row number. So this sets RowMax to the last row of the Rate table. When you add row 5 with Mary's name and rate, this code will automatically adjust.
Revised code
This should be enough to get you started. Welcome to the joys of programming.
' * Require all variables to be declared which means a misspelt name
' is not taken as an implicit declaration
Option Explicit
Sub GetCost()
Dim Estimate As Integer
Dim Assignee As String
Dim TotalCost As Integer
Dim PersonName() As String
Dim PersonRate() As String
Dim InxPerson As Long
Dim RowCrnt As Long
Dim RowMax As Long
' You can declare constants and use them in place of literals.
' You will see why later. I could have made these strings and
' used "A", "B", "D", "E" and "F" as the values. Change if that
' is easier for you.
Const ColS2Name As Long = 1
Const ColS2Rate As Long = 2
Const ColS1Estimate As Long = 4
Const ColS1Assignee As Long = 5
Const ColS1Total As Long = 6
' Before doing anything else we must load PersonName and PersonRate from
' Sheet2. I assume the structure of Sheet2 is:
' A B
' 1 Name Rate
' 2 Rod 20
' 3 Garth 25
' 4 Derek 15
With Sheets("Sheet2")
RowMax = .Cells(Rows.Count, ColS2Name).End(xlUp).Row
' I now know how big I want the the name and rate arrays to be
ReDim PersonName(1 To RowMax - 1)
ReDim PersonRate(1 To RowMax - 1)
' Load these arrays
For RowCrnt = 2 To RowMax
' I could have used 1 and 2 or "A" and "B" for the column
' but this is easier to understand particularly if you come
' back to this macro in six month's time.
PersonName(RowCrnt - 1) = .Cells(RowCrnt, ColS2Name).Value
PersonRate(RowCrnt - 1) = .Cells(RowCrnt, ColS2Rate).Value
Next
End With
With Sheets("Sheet1")
' I am using the same variable for rows in sheets Sheet1 and Sheet2.
' This is OK because I never look at Sheet1 and Sheet2 at the same time.
RowCrnt = 2
Do Until IsEmpty(.Cells(RowCrnt, ColS1Estimate))
Estimate = .Cells(RowCrnt, ColS1Estimate).Value
Assignee = .Cells(RowCrnt, ColS1Assignee).Value
.Cells(RowCrnt, ColS1Total).Value = 0
' Locate the Assignee in the PersonName array and
' extract the matching rate
For InxPerson = 1 To UBound(PersonName)
If PersonName(InxPerson) = Assignee Then
.Cells(RowCrnt, ColS1Total).Value = Estimate * PersonRate(InxPerson)
Exit For
End If
Next
RowCrnt = RowCrnt + 1
Loop
End With
End Sub
Tony's answer is a great solution and introduction to programming and very well written so I've +1 it. However unless I'm missing something code should always be the last resort in excel as it is very slow compared to formulas, I would have thought that a simple lookup would suffice, something like:
=D2*(vlookup(E2,'sheet2'!A:B,2,FALSE))
Copied down the column